Opgelost Speelschema maken loopt vast!

[pd1lg]

Goeiemiddag,
Ik ben weer aan het stoeien met het programma waar ik al eerder een vraag over stelde.
Ik heb in het programma een een map toegevoegd met telbriefjes. Ik heb er formules in geplaatst om de namen en de te maken caramboles automatisch word ingevoerd na het invullen van het wedstrijdnummer. (ja dit is niet met vba gemaakt, alhoewel ik dat wel graag wil, maar heb niet echt ervaring in vba).

Maar nu de vraag, als ik nu een nieuwe speelschema genereer loopt de vba script vast. Dit komt blijkbaar door de map telbriefjes.
Kan iemand mij helpen om dit werkend te krijgen. Het liefst in vba.

 

[pd1lg]

Goeiemiddag,
Ik ben weer aan het stoeien met het programma waar ik al eerder een vraag over stelde.
Ik heb in het programma een een map toegevoegd met telbriefjes. Ik heb er formules in geplaatst om de namen en de te maken caramboles automatisch word ingevoerd na het invullen van het wedstrijdnummer. (ja dit is niet met vba gemaakt, alhoewel ik dat wel graag wil, maar heb niet echt ervaring in vba).

Maar nu de vraag, als ik nu een nieuwe speelschema genereer loopt de vba script vast. Dit komt blijkbaar door de map telbriefjes.
Kan iemand mij helpen om dit werkend te krijgen. Het liefst in vba.

Deze vba script heb ik wel, maar die doet het niet.

Sub ZoekWedstrijd()
    Dim wsData As Worksheet
    Dim wsTel As Worksheet
    Dim i As Long, lastRow As Long

    Set wsData = Worksheets("Speelschema")
    Set wsTel = Worksheets("Telbriefjes")

'    wsTel.Range("E6").Value = ""

    lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRow
        If wsData.Cells(i, "A").Value = wsTel.Range("B2").Value _
        And wsData.Cells(i, "C").Value = wsTel.Range("B6").Value Then

            wsTel.Range("E6").Value = wsData.Cells(i, "D").Value
            Exit Sub
        End If
    Next i
End Sub

 

[snb]

gebruik autofilter

Sub M_snb()
    with sheets("speelschema").cells(1).currentregion
       .autofilter 1,sheets("telbriefjes").cells(2,2)
       .autofilter 3,sheets("telbriefjes").cells(6,2)
      if .columns(1).specialcells(12).count >1 then sheets("telbriefjes").cells(6,5)=.columns(4).specialcells(12).cells(1)
    end with
End Sub

 

[Warme bakkertje]

Je code loopt niet vast maar herberekent bij elke stap in de code.
Schakel Berekenen uit alvorens je het schema genereert en terug aan op het einde v/d code.

Public Sub GenerateSchedule()
    Dim wsP As Worksheet, wsS As Worksheet, wsM As Worksheet
    Set wsP = Sheets("Spelers")
    Set wsS = Sheets("Speelschema")
    Set wsM = Sheets("Matrix")

    Dim n As Long: n = 30
    Dim i As Long, r As Long, w As Long
    Dim rowOut As Long: rowOut = 3

    ' Spelersnamen
    Dim naam(1 To 30) As String
    For i = 1 To n
        naam(i) = wsP.Cells(i + 1, 2).Value
        If naam(i) = "" Then naam(i) = "Speler " & i
    Next i

    ' Startopstelling
    Dim arr(1 To 30) As Long, d As Date
    For i = 1 To n: arr(i) = i: Next i
    d = #1/12/2026#  'Date
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    wsS.Rows("3:2000").ClearContents
    wsM.Range("B2:AE31").ClearContents
    ' =========================
    ' HEENRONDE (1–29)
    ' =========================
    For r = 1 To n - 1
        For w = 1 To n \ 2
            Dim thuis As Long, uit As Long
            thuis = arr(w)
            uit = arr(n - w + 1)

            wsS.Cells(rowOut, 1) = r
            wsS.Cells(rowOut, 2) = d
            wsS.Cells(rowOut, 3) = w
            wsS.Cells(rowOut, 4) = naam(thuis)
            wsS.Cells(rowOut, 5) = Application.Index(Blad1.Range("B1:C31"), Application.Match(naam(thuis), Blad1.Columns(2), 0), 2)
            wsS.Cells(rowOut, 6) = naam(uit)
            wsS.Cells(rowOut, 7) = Application.Index(Blad1.Range("B1:C31"), Application.Match(naam(uit), Blad1.Columns(2), 0), 2)
            wsM.Cells(thuis + 1, uit + 1) = r
            rowOut = rowOut + 1
        Next w
        d = DateAdd("d", 7, d)
        Call Rotate(arr)
    Next r
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Heen- en terugronde gegenereerd (thuis/uit).", vbInformation
End Sub

 

[pd1lg]

Je code loopt niet vast maar herberekent bij elke stap in de code.
Schakel Berekenen uit alvorens je het schema genereert en terug aan op het einde v/d code.

Dankjewel