Office: Zufallszahlen mit Wahrscheinlichkeit

Tony-Walk · 2. Juni 2012

Hallo zusammen,

leider habe ich nicht soviel Ahnung von VBA. Ich habe mir im Internet folgenden Code herausgesucht und etwas "umgebaut"

Code:

Private Sub Liste()
Application.ScreenUpdating = False
Dim Result As Integer
Dim r1 As Range
Dim OutPutRegion As Range
Set OutPutRegion = Sheets("Liste").Range("A1:A10")
Rnd
OutPutRegion.ClearContents
For Each r1 In OutPutRegion.Cells
Result = Int(500 * Rnd) + 1
Do Until WorksheetFunction.CountIf(OutPutRegion, Result) = 0
Result = Int(500 * Rnd) + 1
Loop
r1.Value = Result
r1.Font.Italic = True
r1.Font.Bold = False
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Jetzt zur eigentlichen Frage:

Ich würde gerne eine Wahrscheinlichkeit des erscheinen innerhalb der Zahlen Festlegen.

Bsp:
1-100 = 50%
101-200 = 20%
201-300 = 15%
301-400 = 10%
401-500= 5 %

Kennt sich jemand damit aus und könnte mir helfen?

Vielen Dank
Tony

:)

EarlFred · 3. Juni 2012

Hallo Tony,

schnell bei einer Tasse Kaffee geklimpert und nicht schön, aber probier's mal aus:
Code:

Option Explicit
'1-100 = 50%
'101-200 = 20%
'201-300 = 15%
'301-400 = 10%
'401-500= 5 %

Sub test()
Dim i As Long, lngAnzahl As Long
Dim intAusgabe() As Integer
Dim dblRnd As Double
Dim intErg As Integer

lngAnzahl = 20000

ReDim intAusgabe(1 To lngAnzahl)
For i = 1 To lngAnzahl
dblRnd = Rnd()
Select Case dblRnd
Case 0 To 0.5
intErg = Int(dblRnd * 100)
Case 0.5 To 0.7
intErg = Int(dblRnd * 100) + 100
Case 0.7 To 0.85
intErg = Int(dblRnd * 100) + 200
Case 0.85 To 0.95
intErg = Int(dblRnd * 100) + 300
Case 0.95 To 1
intErg = Int(dblRnd * 100) + 400
End Select
intAusgabe(i) = intErg + 1
Next i
Cells(1, 1).Resize(lngAnzahl, 1) = WorksheetFunction.Transpose(intAusgabe())
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Habe nicht geprüft, ob Deine Grenzbedingungen alle korrekt erfüllt werden - musst Du mal selber schauen.

Grüße
EarlFred

Tony-Walk · 3. Juni 2012

Hallo EarlFred,

danke für Deine schnelle Antwort.

Vllt. habe ich mich falsch ausgedrückt.

Ich würde gerne im Range A1:A10 nur 10 Zahlen aus der Reihe 1-500 Anzeigen lassen und diese eben in gewisser Häufigkeit. Es darf aber keine Zahl doppelt erscheinen.

Vielen Dank
Tony

chris-kaiser · 3. Juni 2012

Hi

nur 10 Zahlen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

5%, 15% ??

sollen auch halbe Zahlen ausgegeben werden? *wink.gif*

Tony-Walk · 3. Juni 2012

Hallo Chris-Kaiser,

hab ich denk nen denkfehler? Es sollen nur Ganze Zahlen ausgegeben werden. In dem Bereich 201-300 & 401-500 tauchen die Zahlen eben mit einer Wahrscheinlichkeit von 5% & 15% auf. Falls das nicht geht dann eben nur volle %-Werte. Bin was das angeht recht flexibel. *Smilie

Beste Grüße
Tony

EarlFred · 3. Juni 2012

Hallo Tony,

die Anforderungen hätte man aus dem Code herauslesen können, aber Du hättest sie natürlich auch sauber beschreiben können...

Zwei Dinge zu ändern:
(1) Es werden nur noch 10 anstelle 20.000 Zahlen berechnet
(2) Es ist zu prüfen, ob eine Zahl bereits im Array vorhanden ist
Code:

Option Explicit

'1-100 = 50%
'101-200 = 20%
'201-300 = 15%
'301-400 = 10%
'401-500= 5 %

Sub test()
Dim i As Long, lngAnzahl As Long
Dim intAusgabe() As Integer
Dim dblRnd As Double
Dim intErg As Integer

lngAnzahl = 10

ReDim intAusgabe(1 To lngAnzahl)
i = 1
Do
dblRnd = Rnd()
Select Case dblRnd
Case 0 To 0.5
intErg = Int(dblRnd * 100) + 1
Case 0.5 To 0.7
intErg = Int(dblRnd * 100) + 100 + 1
Case 0.7 To 0.85
intErg = Int(dblRnd * 100) + 200 + 1
Case 0.85 To 0.95
intErg = Int(dblRnd * 100) + 300 + 1
Case 0.95 To 1
intErg = Int(dblRnd * 100) + 400 + 1
End Select
If IsError(Application.Match(intErg, intAusgabe, 0)) Then
intAusgabe(i) = intErg
i = i + 1
End If
Loop Until i > lngAnzahl
Cells(1, 1).Resize(lngAnzahl, 1) = WorksheetFunction.Transpose(intAusgabe())
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

tauchen die Zahlen eben mit einer Wahrscheinlichkeit von 5% & 15% auf. Falls das nicht geht dann eben nur volle %-Werte. Bin was das angeht recht flexibel
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

5% ist ein "voller" Prozentwert. Flexibel musst Du daher sein: Von 10 Zahlen kann nicht eine einzelne einen Anteil von 5% haben (eine Zahl = 10% der Gesamtheit).
Erklärung:
Bei meinem Code taucht (über eine sehr große Anzahl von Durchläufen) eine Zahl im Bereich 401-500 nur mit 5% Wahrscheinlichkeit auf - es kann bei einer Stichprobe mit 10 Zahlen allerdings möglich sein, dass 2 oder mehr Zahlen aus diesem Bereich vorkommen, was dann 20%, 30% usw. ausmachen kann.

Was nun genau gewünscht ist, weißt aber nur Du.

Grüße
EarlFred

Tony-Walk · 4. Juni 2012

Hallo EarlFred,

tut mir leid das ich nicht genau genug war.

Vielen Dank für Deine Bemühungen.

Genau das wollte ich erreichen. Das im Bereich 401-500 eine Zahl mit 5%tiger Wahrscheinlichkeit "gezogen" wird. Und wenn bei der Stichproben Sichtung eben davon mehr erscheinen ist man eben durch "zufall" öfters in diesen Bereich von 5% gerutscht.

Kurz für mich zum Verständnis in diesem Codeteil werden zB die 50% festgelegt?

Code:

dblRnd = Rnd()
Select Case dblRnd
Case 0 To 0.5
intErg = Int(dblRnd * 100) + 1
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Durch "Case 0 To 0.5" richtig? die nachfolgende Codezeile sagt "1-100" aus?

Könntest Du mir bitte noch kurz erklären wie ich diese Codezeile abändern muss das die Werte auf einem anderen Tabellenblatt ausgegeben werden.

Code:

Cells(1, 1).Resize(lngAnzahl, 1) = WorksheetFunction.Transpose(intAusgabe())
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bsp: Tabelle2

Reicht es aus das Cells(1,1). durch Sheets("Tabelle2").Range("A1:A10") auszutauschen oder wäre das weniger Sinnvoll?

Vielen Dank ich bin echt immer wieder froh um Deine Hilfe!

EarlFred · 4. Juni 2012

Hallo Tony,

in diesem Codeteil werden zB die 50% festgelegt?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

korrekt. Die Wahrscheinlichkeiten der einzelnen Intervalle werden kumuliert und mit der erzeugten Zufallszahl verglichen. Daraufhin wird eine Zahl aus dem "Treffer-"Intervall erzeugt.

Reicht es aus das Cells(1,1). durch Sheets("Tabelle2").Range("A1:A10")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich würde
WorkSheets("Tabelle2")
schreiben, aber im Grunde ist es egal.

Grüße
EarlFred

Tony-Walk · 4. Juni 2012

Hallo EarlFred,

TOP! Vielen Dank! Das klappt echt super!

Jetzt beim rumprobieren und testen kam mir noch folgende Idee - leider habe ich keine passenden "Schlagwörter" gefunden wie ich danach bei Google suchen sollte.

Ich hab die Tabelle "Zähler" und dort steht von A1:A500 die Zahlen 1-500. Ich hätte gerne in Spalte B1:B500 immer "Hochgezählt" wenn die dementsprechende Stichproben Zahl auftaucht.

Bedeuetet wenn die Zahl 1 schon 5 mal aufgetaucht ist sollte in B1 5 stehen. Usw. durchgehend bis Zahl 500. Geht das?

Viele Grüße
Tony

EarlFred · 4. Juni 2012

Hallo Tony,

als kritischer Leser meines eilig in einer Pause zusammengeklimperten Codes ist Dir natürlich der kapitale Fehler aufgefallen, der mir dabei unterlaufen ist, Du warst aber freundlicherweise so rücksichtsvoll, mich nicht durch direkten Hinweis darauf bloßzustellen, sondern hast mir durch geschickte Nachfrage die Möglichkeit eröffnet, diesen Fehler selbst zu bemerken und zu korrigieren. Feiner Zug, danke! *wink.gif*

Code:

Option Explicit

'1-100 = 50%
'101-200 = 20%
'201-300 = 15%
'301-400 = 10%
'401-500= 5 %

Sub test()
Dim i As Long, lngAnzahl As Long
Dim intAusgabe() As Integer
Dim dblRnd As Double
Dim intErg As Integer

lngAnzahl = 10

ReDim intAusgabe(1 To lngAnzahl)
i = 1
Do
dblRnd = Rnd()
Select Case dblRnd
Case 0 To 0.5
intErg = Int(Rnd() * 100) + 1
Case 0.5 To 0.7
intErg = Int(Rnd() * 100) + 100 + 1
Case 0.7 To 0.85
intErg = Int(Rnd() * 100) + 200 + 1
Case 0.85 To 0.95
intErg = Int(Rnd() * 100) + 300 + 1
Case 0.95 To 1
intErg = Int(Rnd() * 100) + 400 + 1
End Select
If IsError(Application.Match(intErg, intAusgabe, 0)) Then
intAusgabe(i) = intErg
Worksheets("Zähler").Cells(intErg, 2) = Worksheets("Zähler").Cells(intErg, 2) + 1
i = i + 1
End If
Loop Until i > lngAnzahl
Worksheets("Tabelle2").Cells(1, 1).Resize(lngAnzahl, 1) = WorksheetFunction.Transpose(intAusgabe())
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße
EarlFred

Tony-Walk · 4. Juni 2012

Hallo EarlFred,

natürlich freut es mich wenn ich auch mal helfen konnte. *tongue.gif*

Vielen vielen Dank! Super Arbeit!

Grüße
Tony

Office: Zufallszahlen mit Wahrscheinlichkeit

Zufallszahlen mit Wahrscheinlichkeit

Zufallszahlen mit Wahrscheinlichkeit

Zufallszahlen mit Wahrscheinlichkeit

Zufallszahlen mit Wahrscheinlichkeit

Zufallszahlen mit Wahrscheinlichkeit - Similar Threads - Zufallszahlen Wahrscheinlichkeit

Zufallszahl mit Markierungen

Mit Zufallszahl Werte sortieren

Zufallszahl einmalig generieren

ZUFALLSZAHL (Funktion)

ID als Zufallszahl erzeugen

Zufallszahlen als Summanden einer vorgegebenen Summe

Zufallszahl generieren sie danach aber als Wert und nicht als Formel haben