Hallo Community,

ich habe folgendes Problem: Ich habe eine Reihe von Brettspielen in einem Excel-Sheet. Dort sind als Input hinterlegt die Spieldauer und die benötigte Spieleranzahl. In 2 anderen Zellen macht man seine Eingabe (Beispiel: Ich habe 120 Minuten Zeit und wir sind zu 4.) und daraufhin kopiert er mir alle Spiele, die diese Anforderungen hinsichtlich Dauer und Spieleranzahl erfüllen und fügt sie an anderer Stelle ein.

Dort wird dann mittels Zufall eine Zeilennummer berechnet in der dann irgendein Spiel steht. Dieses Spiel (der Name) wird mir dann in einer Massagebox angezeigt, sodass ich weiß, welches Spiel er ausgewählt hat.

Ich möchte nun eine Funktion einbauen, die die Wahrscheinlichkeit senkt, dass ein bereits gezogenes Spiel danach nocheinmal gezogen werden kann!

Meine Überlegung dazu war ich lasse, wenn ein Spiel einmal gezogen wurde, hinter dieses Spiel eine 1 schreiben. Wird es das zweite mal gezogen erhöht sich dieser Wert um 1 auf 2 usw. Das ganze geht bis zur Zahl 5.

Anhand der Zahl dahinter lasse ich eine If Schleife laufen für die Fälle Wert < 1 bis Wert < 5. Und hier kommt mein Problem. Wie kann ich in dieser If-Schleife eine Wahrscheinlichkeit einbauen? Zum Beispiel: Wenn Zahl < 2 (bedeutet bereits einmal gezogen) kopiere zu 80% die Zeile trotzdem und mache zu 20% nichts. Analog für die anderen Zahlen...

Nachfolgend mein bisheriger Code: (nutze Office 07)

Sub Schaltfläche4_KlickenSieAuf()
Dim ZZahl
Dim letztezeile As Long
Dim i As Integer, a As Integer, b As Integer
Dim Uebertrag As String
Dim Spielname As String
Dim ZeileSpielname 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
    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 < 3 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 < 4 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 < 5 Then
    a = a + 1
    Worksheets("Tabelle1").Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Worksheets("Tabelle1").Cells(a + 1, 11)
    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) 'Zufallszahl wird ermittelt
zzahl2 = ZZahl1 + 1 'Zur Zufallszahl wird 7 addiert, da es ab Zelle A7 funktionieren soll
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 b < 5 Then
	Cells(ZeileSpielname, 7).Value = b + 1

	ElseIf b >= 5
	Cells(ZeileSpielname, 7).Value = 0

EndIf

End Sub

Danke im Voraus für Eure Hilfe!!!

Gruß Rigo