Hallöchen Forum,
Ich weiss nicht, ob ich grad den Wald vor lauter Bäumen nicht sehe oder sonst irgendwie einen Denkfehler habe.
Folgendes Problem:
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…
Ich hoffe das ist nicht zu kompliziert und mir kann jemand helfen…
'z ist die Anzahl der Gruppen
For z = 1 To 6
'tmpGrp(z) beinhaltet die Spieler, die in der Gruppe platziert werden sollen
If tmpGrp(z) \> 0 Then
i = 1
Do
tmptest = tmpTeilnehmer(Int((UBound(tmpTeilnehmer) - 1 + 1) \* Rnd + 1)) 'Zufallsauswahl aus dem Array
k = 1
'Hier beginnt das Suchen nach dem Zufalls-Spieler
For x = 1 To (UBound(tmpTeilnehmer))
ReDim Preserve tmpCopy(k)
If tmpTeilnehmer(x) = tmptest Then
'die if's sind nötig, da im Array vSpielerInGruppe(z,i) nicht 2 Dimensionen mit redim dimensioniert werden können
If z = 1 Then ReDim Preserve vSpielerInGruppe1(i): vSpielerInGruppe1(i) = tmptest
If z = 2 Then ReDim Preserve vSpielerInGruppe2(i): vSpielerInGruppe2(i) = tmptest
If z = 3 Then ReDim Preserve vSpielerInGruppe3(i): vSpielerInGruppe3(i) = tmptest
If z = 4 Then ReDim Preserve vSpielerInGruppe4(i): vSpielerInGruppe4(i) = tmptest
If z = 5 Then ReDim Preserve vSpielerInGruppe5(i): vSpielerInGruppe5(i) = tmptest
If z = 6 Then ReDim Preserve vSpielerInGruppe6(i): vSpielerInGruppe6(i) = tmptest
Else
tmpCopy(k) = tmpTeilnehmer(x)
k = k + 1
End If
Next
i = i + 1
tmpTeilnehmer = tmpCopy
Loop Until i \> tmpGrp(z)
Else
Exit For
End If
Next
lg micha
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
Hallo Reinhard,
Das ist perfekt!!! Herzlichen Dank!
lg Micha