AW: Gruppenauslosung
28.06.2011 09:22:56
Dirk
Hallo Juergen,
hier noch ein angepasstes Makro, damit die Gruppenzuordnung passt. Ich habe fuer die Gruppe eine Variable definiert und zaehle diese hoch. deine Kalkulation der Gruppennummer lieferte einen falschen wert.
Sub AuslosungStart()
Dim rngTN As Range, rngRang As Range, I As Integer, rngGruppen As Range, Gruppe As Long
Dim ii, Positionen As Integer
If Cells(13, "I") "Auslosung" Then
MsgBox "Damit die Auslosung gestartet werden kann muß in Zelle I12 ein ""a"" eingetragen _
werden!"
Exit Sub
End If
VereinSortieren ' Auslosung funktioniert besser, wenn nach Verein sortiert ist
ZuvieleimVerein = False
For ii = 1 To 50
AuslosungGruppenVereineGesetzt
If ZuvieleimVerein = True Then Exit Sub
If Fertig Then
' MsgBox "Fertig beim " & ii & ". Durchlauf"
'Übertragen der Gruppen und Position in die Liste
With Sheets("Teilnehmer")
'Bereich mit Spielern/Vereinsnamen in Blatt Teilnehmer bis Spalte H
Set rngTN = .Range(.Cells(2, "B"), .Cells(.Cells(.Rows.Count, "B").End(xlUp).Row, " _
H"))
'Anzahl Positionen in den Gruppen
Positionen = Application.WorksheetFunction.CountA(.Columns("J"))
'Bereich mit den Daten der Gruppenauslosung
Set rngGruppen = .Range(.Cells(2, "K"), .Cells(1 + Positionen, .Cells(2, .Columns. _
Count).End(xlToLeft).Column))
End With
Gruppe = 1
For I = 1 To rngGruppen.Columns.Count Step 3
For K = 1 To Positionen
If rngGruppen(K, I) "" Then
For J = 1 To rngTN.Rows.Count
'Vergleich von Name und Verein in Gruppe und Teilnehmerliste
If rngGruppen(K, I) = rngTN(J, 1) And rngGruppen(K, I + 2) = rngTN(J, 3) Then
rngTN(J, 6) = Gruppe 'Gruppe
rngTN(J, 7) = K 'Position in Gruppe
Exit For
End If
Next J
End If
Next K
Gruppe = Gruppe + 1
Next I
Exit For
End If
Next ii
If ii > 50 Then MsgBox "Neustart erforderlich - noch kein Ergebnis"
End Sub
Gruss
Dirk aus Dubai