Sub
Schaltfläche4_KlickenSieAuf()
Dim
ZZahl
Dim
letztezeile
As
Long
Dim
i, a, b
As
Integer
Dim
Uebertrag
As
String
Dim
Spielname
As
String
Dim
ZeileSpielname
As
Integer
Dim
RandomZahl
As
Integer
Range(Cells(2, 11), Cells(1000, 16)).
Select
Selection.ClearContents
For
i = 2
To
ActiveSheet.Cells(Rows.Count, 1).
End
(xlUp).Row
If
Cells(3, 9).Value <= Cells(i, 3).Value
And
Cells(7, 9).Value >= Cells(i, 4).Value
And
Cells(i, 7).Value < 1
Then
a = a + 1
Worksheets(
"Tabelle1"
).Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Worksheets(
"Tabelle1"
).Cells(a + 1, 11)
ElseIf
Cells(3, 9).Value <= Cells(i, 3).Value
And
Cells(7, 9).Value >= Cells(i, 4).Value
And
Cells(i, 7).Value < 2
Then
Randomize
RandomZahl = Int((10 - 0 + 1) * Rnd + 0)
Select
Case
RandomZahl
Case
1, 2, 3, 4, 5, 6, 7, 8
a = a + 1
Worksheets(
"Tabelle1"
).Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Worksheets(
"Tabelle1"
).Cells(a + 1, 11)
Case
9, 10
End
Select
ElseIf
Cells(3, 9).Value <= Cells(i, 3).Value
And
Cells(7, 9).Value >= Cells(i, 4).Value
And
Cells(i, 7).Value < 3
Then
Randomize
RandomZahl = Int((10 - 0 + 1) * Rnd + 0)
Select
Case
RandomZahl
Case
1, 2, 3, 4, 5, 6
a = a + 1
Worksheets(
"Tabelle1"
).Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Worksheets(
"Tabelle1"
).Cells(a + 1, 11)
Case
7, 8, 9, 10
End
Select
ElseIf
Cells(3, 9).Value <= Cells(i, 3).Value
And
Cells(7, 9).Value >= Cells(i, 4).Value
And
Cells(i, 7).Value < 4
Then
Randomize
RandomZahl = Int((10 - 0 + 1) * Rnd + 0)
Select
Case
RandomZahl
Case
1, 2, 3, 4
a = a + 1
Worksheets(
"Tabelle1"
).Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Worksheets(
"Tabelle1"
).Cells(a + 1, 11)
Case
5, 6, 7, 8, 9, 10
End
Select
ElseIf
Cells(3, 9).Value <= Cells(i, 3).Value
And
Cells(7, 9).Value >= Cells(i, 4).Value
And
Cells(i, 7).Value < 5
Then
Randomize
RandomZahl = Int((10 - 0 + 1) * Rnd + 0)
Select
Case
RandomZahl
Case
1, 2
a = a + 1
Worksheets(
"Tabelle1"
).Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Worksheets(
"Tabelle1"
).Cells(a + 1, 11)
Case
3, 4, 5, 6, 7, 8, 9, 10
End
Select
Else
End
If
Next
i
ZZahl1 = 0
zzahl2 = 0
Uebertrag = 0
letztezeile = Cells(Rows.Count, 11).
End
(xlUp).Row
letztezeile = letztezeile - 1
Randomize
ZZahl1 = Int((letztezeile * Rnd) + 1)
zzahl2 = ZZahl1 + 1
Uebertrag = Cells(zzahl2, 11).Value
MsgBox Uebertrag
Spielname = Uebertrag
ZeileSpielname = Application.WorksheetFunction.Match(Spielname, Cells(1, 1).EntireColumn,
False
)
b = Cells(ZeileSpielname, 7).Value
If
Cells(ZeileSpielname, 7).Value < 4
Then
Cells(ZeileSpielname, 7).Value = b + 1
ElseIf
Cells(ZeileSpielname, 7).Value >= 4
Then
Cells(ZeileSpielname, 7).Value = 0
End
If
End
Sub