Excel VBA: Array 'verwürfeln' und aufteilen

Computer: Software & Programmierung Visual Basic
#1

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

#2

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

Erstes Feld eines Arrays mittels ubound füllen
#3

Hallo Reinhard,

Das ist perfekt!!! Herzlichen Dank!

lg Micha