Sub
CommandButton2_Click()
Dim
yarr(), parr()
Randomize Timer
Set
Quelle = Sheets(
"FCLM_Data"
)
Set
ziel = Sheets(
"Board"
)
ziel.Cells.ClearContents
z2 = 9: s2 = 3: z3 = 9: s3 = 12: z4 = 13: s4 = 12: ymax = 6: pmax = 2
yvorh = Application.WorksheetFunction.CountIf(Quelle.Columns(13),
"y"
)
pvorh = Application.WorksheetFunction.CountIf(Quelle.Columns(13),
"p"
)
ReDim
yarr(yvorh, 2)
ReDim
parr(pvorh, 2)
For
z1 = 1
To
Quelle.Cells(Rows.Count, 1).
End
(xlUp).Row
If
s2 > 10
Then
s2 = 3
z2 = z2 + 2
End
If
If
Quelle.Cells(z1, 1) <>
""
Then
If
Quelle.Cells(z1, 13) =
"y"
Then
y = y + 1
yarr(y, 1) = Quelle.Cells(z1, 1)
ElseIf
Quelle.Cells(z1, 13) =
"p"
Then
p = p + 1
parr(p, 1) = Quelle.Cells(z1, 1)
Else
ziel.Cells(z2, s2) = Quelle.Cells(z1, 1)
s2 = s2 + 1
End
If
End
If
Next
z1
For
i = 1
To
IIf(ymax <= yvorh, ymax, yvorh)
If
ymax <= yvorh
Then
Do
zufall = Int(Rnd * UBound(yarr, 1)) + 1
Loop
Until
yarr(zufall, 2) =
""
Else
zufall = i
End
If
yarr(zufall, 2) =
"gezogen"
If
s3 > 18
Then
s3 = 12
z3 = z3 + 2
End
If
ziel.Cells(z3, s3) = yarr(zufall, 1)
s3 = s3 + 1
Next
i
For
i = 1
To
IIf(pmax <= pvorh, pmax, pvorh)
If
pmax <= pvorh
Then
Do
zufall = Int(Rnd * UBound(parr, 1)) + 1
Loop
Until
parr(zufall, 2) =
""
Else
zufall = i
End
If
parr(zufall, 2) =
"gezogen"
If
s4 > 18
Then
s4 = 12
z4 = z4 + 2
End
If
ziel.Cells(z4, s4) = parr(zufall, 1)
s4 = s4 + 1
Next
i
For
i = 1
To
yvorh
If
yarr(i, 2) =
""
Then
If
s2 > 10
Then
s2 = 3
z2 = z2 + 2
End
If
ziel.Cells(z2, s2) = yarr(i, 1)
s2 = s2 + 1
End
If
Next
i
For
i = 1
To
pvorh
If
parr(i, 2) =
""
Then
If
s2 > 10
Then
s2 = 3
z2 = z2 + 2
End
If
ziel.Cells(z2, s2) = parr(i, 1)
s2 = s2 + 1
End
If
Next
i
End
Sub