Oder hab ich dich falsch verstanden und du willst nicht die ersten 6 Y-Werte des Quelltabellenblatts sondern zufällig ausgewählte 6 Werte aus den vorhandenen Y-Werten in das Ziel kopieren? Dann versuch mal diesen Code:
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 ymax
Do
zufall = Int(Rnd * UBound(yarr, 1)) + 1
Loop Until yarr(zufall, 2) = ""
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 pmax
Do
zufall = Int(Rnd * UBound(parr, 1)) + 1
Loop Until parr(zufall, 2) = ""
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
End Sub
Gruß Mr. K.
|