Hallo lucki,
ich habe jetzt einmal ein Makro für das 16er-Raster erstellt. Hier die bearbeitete Datei: Download
Und hier die Makros:
Sub Auslosung16er()
Dim arrSpieler(15, 1) As Variant
Dim arrAuslosung() As Integer
Dim lngZeile As Long
Dim intBye As Integer
Dim intZuBye As Integer
Dim intMax As Integer
Dim d As Integer
Dim n As Integer
Dim iTemp As Integer
Dim iZ As Integer
Dim i As Integer
'Spieler aus Nennliste einlesen und Anzahl der Bye zählen - Array beginnt bei 0
With Worksheets("Nennliste")
For lngZeile = 3 To 18
'Spieler aus Spalte B der Setzliste in Array einlesen
arrSpieler(lngZeile - 3, 0) = .Cells(lngZeile, 2).Value
'Verband aus Spalte C der Setzliste auslesen
arrSpieler(lngZeile - 3, 1) = .Cells(lngZeile, 3)
'Zähler für Bye erhöhen, wenn Bye vorhanden ist
If arrSpieler(lngZeile - 3, 0) = "Bye" Then intBye = intBye + 1
Next lngZeile
End With
'16er Raster löschen
Call clear16er
'die ersten 4 Spieler dem Raster zuweisen
With Worksheets("16er Raster Einzel Hauptbewerb")
.Range("C15") = arrSpieler(0, 0) 'an Nummer 1 gesetzter Spieler
.Range("D15") = arrSpieler(0, 1) 'Landesverband
.Range("C44") = arrSpieler(1, 0) 'an Nummer 2 gesetzter Spieler
.Range("D44") = arrSpieler(1, 1) 'Landesverband
.Range("C31") = arrSpieler(2, 0) 'an Nummer 3 gesetzter Spieler
.Range("D31") = arrSpieler(2, 1) 'Landesverband
.Range("C23") = arrSpieler(3, 0) 'an Nummer 4 gesetzter Spieler
.Range("D23") = arrSpieler(3, 1) 'Landesverband
'Feld für Auslosung restliche dimensionieren, ohne 4 gesetzte Spieler und ohne max 4 Bye
Select Case intBye
Case 0 To 4
intMax = UBound(arrSpieler) - 4 - intBye
Case Is > 4
intMax = UBound(arrSpieler) - 8 '4 gesetzte Spieler (0 - 3) und die entsprechenden Byes
End Select
'Nun Array für Auslosung redimensionieren
ReDim arrAuslosung(intMax)
'Array mit Spieler ab dem 5 Spieler durchlaufen
For d = 4 To UBound(arrSpieler)
'Prüfen ob Bye für die ersten 4 Spieler vorliegt
'hier kleiner 4, da Zähler intZuBye mit Null beginnt und erst im IF-Block der Wert zugewiesen wird
If arrSpieler(d, 0) = "Bye" And intZuBye < 4 Then
'falls ja Zähler für zugewiesene Bye erhöhen
intZuBye = intZuBye + 1
'nun Bye abhängig von Anzahl den ersten 4 Spielern zuweisen
Select Case intZuBye
Case 1 '1. Bye zuordnen
.Range("C16") = "Bye"
'und Spieler 1 in die nächste Runde schreiben
.Range("G17") = arrSpieler(0, 0)
Case 2 '2. Bye zuordnen
.Range("C43") = "Bye"
'und Spieler 2 in die nächste Runde schreiben
.Range("G42") = arrSpieler(1, 0)
Case 3 '3. Bye zuordnen
.Range("C32") = "Bye"
'und Spieler 3 in die nächste Runde schreiben
.Range("G33") = arrSpieler(2, 0)
Case 4 '4. Bye zuordnen
.Range("C24") = "Bye"
'und Spieler 4 in die nächste Runde schreiben
.Range("G25") = arrSpieler(3, 0)
End Select
Else
'falls nicht, dann die Nummer in das Feld für die Auslosung schreiben
arrAuslosung(n) = d
'und Variable erhöhen
n = n + 1
End If
Next d
'nun Feld für Auslosung mischen
For i = UBound(arrAuslosung) To 0 Step -1
Randomize Timer
iZ = Int((i * Rnd) + 1)
iTemp = arrAuslosung(iZ)
arrAuslosung(iZ) = arrAuslosung(i)
arrAuslosung(i) = iTemp
Next i
'Daten in Tabelle schreiben
'dazu Variable d zurücksetzen
d = 0
'Gegner an 1 gesetzten Spieler
'dazu erst prüfen, ob hier ein Bye steht
If .Range("C16").Value = "" Then
'falls hier kein Bye steht, dann ausgelosten Gegner zuordnen
.Range("C16") = arrSpieler(arrAuslosung(d), 0) 'Name des Gegners
.Range("D16") = arrSpieler(arrAuslosung(d), 1) 'Verband
'und Zähler für Feld Auslosung erhöhen
d = d + 1
End If
'nächste Paarung
.Range("C19") = arrSpieler(arrAuslosung(d), 0) 'Name des Spielers
.Range("D19") = arrSpieler(arrAuslosung(d), 1) 'Verband
d = d + 1
.Range("C20") = arrSpieler(arrAuslosung(d), 0) 'Name des Spielers
.Range("D20") = arrSpieler(arrAuslosung(d), 1) 'Verband
d = d + 1
'Prüfen, ob Bye und falls ja, dann Gegner in die nächste Runde schreiben
If .Range("C19").Value = "Bye" Then .Range("G18") = .Range("C20").Value
If .Range("C20").Value = "Bye" Then .Range("G18") = .Range("C19").Value
'Gegner für an 4 gesetzten Spieler
If .Range("C24").Value = "" Then
'falls hier kein Bye steht, dann ausgelosten Gegner zuordnen
.Range("C24") = arrSpieler(arrAuslosung(d), 0) 'Name des Gegners
.Range("D24") = arrSpieler(arrAuslosung(d), 1) 'Verband
'und Zähler für Feld Auslosung erhöhen
d = d + 1
End If
'nächste Paarung
.Range("C27") = arrSpieler(arrAuslosung(d), 0) 'Name des Spielers
.Range("D27") = arrSpieler(arrAuslosung(d), 1) 'Verband
d = d + 1
.Range("C28") = arrSpieler(arrAuslosung(d), 0) 'Name des Spielers
.Range("D28") = arrSpieler(arrAuslosung(d), 1) 'Verband
d = d + 1
'Prüfen, ob Bye und falls ja, dann Gegner in die nächste Runde schreiben
If .Range("C27").Value = "Bye" Then .Range("G26") = .Range("C28").Value
If .Range("C28").Value = "Bye" Then .Range("G26") = .Range("C27").Value
'Gegner für an 3 gesetzten Spieler
If .Range("C32").Value = "" Then
'falls hier kein Bye steht, dann ausgelosten Gegner zuordnen
.Range("C32") = arrSpieler(arrAuslosung(d), 0) 'Name des Gegners
.Range("D32") = arrSpieler(arrAuslosung(d), 1) 'Verband
'und Zähler für Feld Auslosung erhöhen
d = d + 1
End If
'nächste Paarung
.Range("C35") = arrSpieler(arrAuslosung(d), 0) 'Name des Spielers
.Range("D35") = arrSpieler(arrAuslosung(d), 1) 'Verband
d = d + 1
.Range("C36") = arrSpieler(arrAuslosung(d), 0) 'Name des Spielers
.Range("D36") = arrSpieler(arrAuslosung(d), 1) 'Verband
d = d + 1
'Prüfen, ob Bye und falls ja, dann Gegner in die nächste Runde schreiben
If .Range("C35").Value = "Bye" Then .Range("G34") = .Range("C36").Value
If .Range("C36").Value = "Bye" Then .Range("G34") = .Range("C35").Value
'nächste Paarung
.Range("C39") = arrSpieler(arrAuslosung(d), 0) 'Name des Spielers
.Range("D39") = arrSpieler(arrAuslosung(d), 1) 'Verband
d = d + 1
.Range("C40") = arrSpieler(arrAuslosung(d), 0) 'Name des Spielers
.Range("D40") = arrSpieler(arrAuslosung(d), 1) 'Verband
d = d + 1
'Prüfen, ob Bye und falls ja, dann Gegner in die nächste Runde schreiben
If .Range("C39").Value = "Bye" Then .Range("G41") = .Range("C40").Value
If .Range("C40").Value = "Bye" Then .Range("G41") = .Range("C39").Value
'Gegner für an 2 gesetzten Spieler
If .Range("C43").Value = "" Then
'falls hier kein Bye steht, dann ausgelosten Gegner zuordnen
.Range("C43") = arrSpieler(arrAuslosung(d), 0) 'Name des Gegners
.Range("D43") = arrSpieler(arrAuslosung(d), 1) 'Verband
End If
End With
End Sub
Sub clear16er()
With Worksheets("16er Raster Einzel Hauptbewerb")
.Range("C15:D16").ClearContents
.Range("G17:G18").ClearContents
.Range("C19:D20").ClearContents
.Range("I21:I22").ClearContents
.Range("C23:D24").ClearContents
.Range("G25:G26").ClearContents
.Range("C27:D28").ClearContents
.Range("K29:K30").ClearContents
.Range("C31:D32").ClearContents
.Range("G33:G34").ClearContents
.Range("C35:D36").ClearContents
.Range("I37:I38").ClearContents
.Range("C39:D40").ClearContents
.Range("G41:G42").ClearContents
.Range("C43:D44").ClearContents
End With
End Sub
Die Auslosung erfolgt im Makro selbst. Teste mal, ob alles so funktioniert wie du willst.
Gruß
M.O.