Excel VBA: Array zufällig auf 6 Arrays aufteilen
Ich habe ein Array mit Spielernamen.
Dieses Array möchte ich jetzt auf andere Arrays (die Gruppen)
nach dem Zufallsprinzip aufteilen. Folgenden code hab ich
bisher, der allerdings für die letzte Gruppe immer einige
Leere Strings ablegt…
Am Ende möchte ich gerne die Arrays vSpielerInGruppen1-6 mit
den entsprechenden Namen gefüllt haben…
Hallo michael,
Option Explicit
'
Sub nn()
Dim tmpTeilnehmer() As String, N As Integer, z As Integer
Dim tmpKurz1, tmpKurz2, X, Anz, Gr As Byte
Dim vSpielerInGruppe1(), vSpielerInGruppe2(), vSpielerInGruppe3(), vSpielerInGruppe4()
Dim vSpielerInGruppe5(), vSpielerInGruppe6()
Dim grAnz(5)
ReDim tmpTeilnehmer(25)
For N = 0 To UBound(tmpTeilnehmer)
tmpTeilnehmer(N) = Chr(65 + N)
Next N
tmpKurz1 = tmpTeilnehmer
Anz = (UBound(tmpKurz1) + 1)
For X = 0 To UBound(tmpTeilnehmer)
z = Int(Rnd() \* Anz)
Gr = Gr + 1
If Gr = 7 Then Gr = 1
Select Case Gr
Case 1
ReDim Preserve vSpielerInGruppe1(grAnz(0))
vSpielerInGruppe1(grAnz(0)) = tmpKurz1(z)
grAnz(0) = grAnz(0) + 1
Case 2
ReDim Preserve vSpielerInGruppe2(grAnz(1))
vSpielerInGruppe2(grAnz(1)) = tmpKurz1(z)
grAnz(1) = grAnz(1) + 1
Case 3
ReDim Preserve vSpielerInGruppe3(grAnz(2))
vSpielerInGruppe3(grAnz(2)) = tmpKurz1(z)
grAnz(2) = grAnz(2) + 1
Case 4
ReDim Preserve vSpielerInGruppe4(grAnz(3))
vSpielerInGruppe4(grAnz(3)) = tmpKurz1(z)
grAnz(3) = grAnz(3) + 1
Case 5
ReDim Preserve vSpielerInGruppe5(grAnz(4))
vSpielerInGruppe5(grAnz(4)) = tmpKurz1(z)
grAnz(4) = grAnz(4) + 1
Case 6
ReDim Preserve vSpielerInGruppe6(grAnz(5))
vSpielerInGruppe6(grAnz(5)) = tmpKurz1(z)
grAnz(5) = grAnz(5) + 1
End Select
For N = z To Anz - 2
tmpKurz1(N) = tmpKurz1(N + 1)
Next N
Anz = Anz - 1
Next X
For N = 0 To UBound(vSpielerInGruppe1)
Cells(N + 1, 1) = vSpielerInGruppe1(N)
Next N
For N = 0 To UBound(vSpielerInGruppe2)
Cells(N + 1, 2) = vSpielerInGruppe2(N)
Next N
For N = 0 To UBound(vSpielerInGruppe3)
Cells(N + 1, 3) = vSpielerInGruppe3(N)
Next N
For N = 0 To UBound(vSpielerInGruppe4)
Cells(N + 1, 4) = vSpielerInGruppe4(N)
Next N
For N = 0 To UBound(vSpielerInGruppe5)
Cells(N + 1, 5) = vSpielerInGruppe5(N)
Next N
For N = 0 To UBound(vSpielerInGruppe6)
Cells(N + 1, 6) = vSpielerInGruppe6(N)
Next N
End Sub
Gruß
Reinhard