Option Explicit
Dim anzahlVergeben As Integer
Public Sub generate_groups()
Dim wks As Worksheet
Set wks = Worksheets("Tabelle1")
Dim SpielerProGruppe As Integer
SpielerProGruppe = 3
Dim intAnzahl As Integer, i As Integer
intAnzahl = wks.Cells(Rows.Count, 1).End(xlUp).Row
If intAnzahl Mod SpielerProGruppe <> 0 Then
MsgBox "Anzahl Spieler pro Gruppe gehen nicht auf.", vbInformation
Exit Sub
End If
Dim strSpieler() As String
ReDim strSpieler(intAnzahl - 1)
Dim strSpielerV() As String
ReDim strSpielerV(intAnzahl - 1)
Dim strGruppe() As String
ReDim strGruppe(SpielerProGruppe - 1)
For i = 1 To intAnzahl
strSpieler(i - 1) = wks.Cells(i, 1)
Next i
anzahlVergeben = 0
Dim j As Integer, k As Integer
For i = 1 To intAnzahl / SpielerProGruppe
k = 0
Call get_gruppe(intAnzahl, strGruppe(), strSpieler(), strSpielerV, SpielerProGruppe)
For j = 3 To 3 + (SpielerProGruppe - 1)
wks.Cells(i, j) = strGruppe(k)
k = k + 1
Next j
Next i
End Sub
Private Sub get_gruppe(ByVal AnzahlSpieler As Integer, ByRef Gruppe() As String, ByRef Spieler() As String, ByRef SpielerV() As String, ByVal SpielerProGruppe As Integer)
Dim i As Integer, j As Integer
For i = 0 To SpielerProGruppe - 1
Randomize
j = Int((AnzahlSpieler - 1 + 1) * Rnd + 1)
Do While isInGroup(SpielerV(), Spieler(j - 1))
Randomize
j = Int((AnzahlSpieler - 1 + 1) * Rnd + 1)
Loop
Gruppe(i) = Spieler(j - 1)
SpielerV(anzahlVergeben) = Spieler(j - 1)
anzahlVergeben = anzahlVergeben + 1
Next i
End Sub
Private Function isInGroup(ByRef SpielerV() As String, ByVal Spieler As String) As Boolean
Dim i As Integer
For i = 0 To anzahlVergeben - 1
If SpielerV(i) = Spieler Then
isInGroup = True
Exit Function
End If
Next i
isInGroup = False
End Function