In Zufallsgenerator bestimmte Zeilen wenn Anzahl auf "null" nicht mehr berücksichtigen

Question

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

Answer 1

Hallo,
kann mir denn jetzt auch ein/e VBA Frau/Mann helfen.
Biiiiiitte

LG Karsten

Answer 2

Hallo Ihr guten Geister dieses Forums,
sind denn schon alle im Urlaub oder ist das jetzt zu schwierig :-)
Bitte, bitte helft mir doch. Antwort 4 ist der Link zur Musterdatei und Antwort 8 ist noch mal eine ausführliche beschreibung. Wenn noch eine Frage offen ist und geklärt werden muß bitte einfach fragen. Ich möchte doch geholfen bekommen.
Vielen Dank im voraus.
LG Karsten

Answer 3

hi all :-))

statt artikelanzahl mit stueckzahlenangaben,wuerde ich es so machen

bei 200 soundso,auch 200 zeilen und nicht nur eine

nach diesem prinzip ist folgendes makro,das einen gewinn zieht und dann loescht

Sub Zufall01()
Randomize Timer
Dim WertZufall As Long
WertZufall = Int(Rnd * Worksheets("Gewinne").Cells(Rows.Count, 1).End(xlUp).Row) + 1
Worksheets("Gewinne").Rows(WertZufall).Delete Shift:=xlUp
End Sub

somit hast du auch den mengen entsprechende zufallsverteilung

allerding konnte ich mit deinen losnummern und dessen verfahrensweisen nichts anfangen

Answer 4

hallo nighty,
vielen Dank für Deine Antwort,
die losnummern sind für die verlosung eigendlich nicht notwendig. wenn du es mal ausprobiert hast geht es mit jeder Zahl. die nummern sind nur für mich wichtig wegen bestellung dieser, verwaltung und buchführung. Wo baue ich den dieses Makro ein. Benutze ich das Makro aus meiner Tabelle dafür nicht mehr. wie übertrage ich denn aus einem einfachen Tabellenblatt nennen wir es einfach Daten die Gewinne anhand der Anzahl der in Spalte C angegebenen Menge in das Tabellenblatt "Gewinne" 200 mal Trostpreis, 5 mal Hauptgewinn...... in einzelne Zeilen. Geht sowas mit Button? Soll auch für den Azubi so einfach sein wie möglich. Namen eingeben, Nummer eingeben, Menge eingeben und Button drücken und alles steht in dem Tabellenblatt " Gewinne und zwar von A1:C......... beginnend. Durch das Makro gezogener Gewinn soll dann in Tabellenblatt3 A1 angezeigt werden . Hilfst Du mir dabei?
Vielen Dank im voraus für Deine Hilfe
LG Karsten

Answer 5

hi karsten :-)

du hast post

gruss nighty

Answer 6

hi all :-)

als ansatz dienten diese makros

gruss nighty

MappenAufbau
WorkSheets("Eingabe")
WorkSheets("Gewinne")
WorkSheets("Ausgabe")

WorkSheets("Eingabe")
SpalteA=Anzahl
SpalteB=Artikel

Sollten alle daten eingetragen sein

makro NeueGewinne starten

man landet nun auf der tabelle
WorkSheets("Ausgabe")

hier das Makro GewinnZiehen starten

Option Explicit
Sub GewinnZiehen()
Randomize Timer
Dim WertZufall As Long
Dim Zeile As Long
Zeile = Worksheets("Gewinne").Cells(Rows.Count, 1).End(xlUp).Row - 1
If Zeile > 0 Then
WertZufall = Int(Rnd * Zeile) + 2
Worksheets("Ausgabe").Cells(2, 1) = Worksheets("Gewinne").Cells(WertZufall, 1)
Worksheets("Ausgabe").Cells(2, 2) = Worksheets("Gewinne").Cells(WertZufall, 2)
Worksheets("Gewinne").Rows(WertZufall).Delete Shift:=xlUp
Else
Worksheets("Ausgabe").Cells(2, 1) = "Gewinne alle"
Worksheets("Ausgabe").Cells(2, 2) = ""
End If
End Sub

Sub NeueGewinne()
Dim Zeile As Long
Dim ZeilenDurchLauf As Long
Worksheets("Gewinne").Range("A2:IV65535") = ""
For ZeilenDurchLauf = 2 To Worksheets("Eingabe").Cells(Rows.Count, 1).End(xlUp).Row
Zeile = Worksheets("Gewinne").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Gewinne").Range(Worksheets("Gewinne").Cells(Zeile + 1, 1), Worksheets("Gewinne").Cells(Zeile + Worksheets("Eingabe").Cells(ZeilenDurchLauf, 1), 1)) = _
Worksheets("Eingabe").Cells(ZeilenDurchLauf, 2)
Worksheets("Gewinne").Range(Worksheets("Gewinne").Cells(Zeile + 1, 2), Worksheets("Gewinne").Cells(Zeile + Worksheets("Eingabe").Cells(ZeilenDurchLauf, 1), 2)) = _
Worksheets("Eingabe").Cells(ZeilenDurchLauf, 3)
Next ZeilenDurchLauf
Worksheets("Ausgabe").Range("A2:B2") = ""
Worksheets("Ausgabe").Activate
End Sub

Answer 7

Hallo Nighty,
vielen vielen dank für deine dilfe. ich denke, daß ich mit dieser Antwort von dir, es hin bekomme.
wenn noch ne frage sein sollte, darf ich dich dann noch mal kontaktieren?
Ansonsten vielen lieben dank nochmal und einen wunderschönen tag.
Gruß Karsten