Hallo Ihr guten Geister dieses Forums, habe eine Auslosung mit eurer Hilfe bereits hin bekommen (Forumssuche).
Nun stoße ich aber auf ein Problem welches ich nicht alleine lösen kann. Mit dem unten angegebenen Zufallsgenerator kann ich zwar Ziehungen durchführen aber der zieht halt sollange weiter bis ich keine Lust mehr habe. In dem Tabellenblatt "Gewinne" habe ich in der Spalte A die Namen, in Spalte B die dazugehörigen Nummern (sind für diese Sache unerheblich) und in Spalte C die Anzahl der zu Verfügung stehenden Gewinne. Ich habe es nun auch schon hin bekommen das die Ahnzahl bei jeder passende Ziehung um eins reduziert wird. Jetzt mein Problem: wie muß der Zufalssgenerator geändert werden , das er die Gewinne die in der Spalte C eine Null oder kleiner (Minuszahlen) haben, nicht mehr berücksichtigt werden, bis ich die Zahlen wieder per Hand erhöhe und wie kann ich den Zufallsgenerator dazu bringen die Häufigkeit der Ziehungen des einzelnen Gewinnes prozentual in Abhängigkeit der Anzahl in Spalte C zu machen. z.B.: Trostpreise 200 Stück, kleinerer Gewinn 100 Stück, nächst höherer Gewinn 50 Stück ... bis zum Hauptgewinn sagen wir mal 5 Stück.
Ich hoffe ich habe Euch nicht vor eine unlösbare Aufgabe gestellt.


Sub Zufall1()
Dim G(20) As Integer
Dim vorhanden As Boolean
Dim Anz, a, i, z, x
'Anzahl der Einträge in Tabelle1 ermitteln
Anz = Tabelle1.Range("A65536").End(xlUp).Row
'Anzahl der zu ziehenden Namen
a = 1
For i = 1 To a 'Ziehung
Do 'Prüfschleife
Randomize 'Echte Zufallszahl erzeugen (1-Anz)
z = Int(Rnd * Anz) + 1
Debug.Print z
vorhanden = False 'Merker zurücksetzen
For x = 1 To i 'Prüfung, ob Zahl schon gezogen wurde
If G(x) = z Then 'Wurde ZZ schon gezogen?
vorhanden = True 'Ja, markieren
Exit For
End If
Next 'nein, nächte Zahl prüfen.
If Not vorhanden Then 'Wenn Zufallszahl nicht markiert wurde,
G(i) = z 'dann diese notieren und
Exit Do 'Prüfschleife verlassen,
End If
Loop 'ansonsten einen neuen Ziehungsversuch machen.
Next
'Ausgabe der Namen auf Tabelle 3
With Tabelle3
For i = 1 To a
.Cells(i, 1) = Tabelle1.Cells(G(i), 1)
Next
End With
Sheets("Tabelle3").Select
End Sub

Vielen Dank im voraus für Eure Bemühungen.
LG Karsten