Zufallszahlen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Paul,
ich hab mal rumprobiert. Die Lösung ist nicht schön, aber scheint soweit zu funktionieren.
Ich erstelle ein Array in der Größe der benötigten Zahlen.
Dann wird das Array mit den erwünschten Zufallszahlen gefüllt.
Nun wird die Summe des Array mit der gewünschten Summe abgeglichen und ggf. per Zufall einzelne Zahlen angepasst.
Ist nicht das beste, aber hilft vielleicht.
Gruß
--- Makro ---


Option Explicit
Sub ZFM()
Dim AnzahlZahlen As Long
Dim KZahl As Long
Dim GZahl As Long
Dim SollSumme As Long
Dim AusgabeZeile As Long
Dim WS As Worksheet
Set WS = ActiveSheet
AnzahlZahlen = WS.Range("A1")
KZahl = WS.Range("A2")
GZahl = WS.Range("A3")
SollSumme = WS.Range("A4")
AusgabeZeile = 10
Dim M As Variant
Dim Mi As Long
Dim S As Long
Dim zMi As Long
ReDim M(AnzahlZahlen)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
For Mi = LBound(M) To UBound(M)
M(Mi) = Int(Application.WorksheetFunction.RandBetween(KZahl, GZahl))
Next Mi
S = Application.WorksheetFunction.Sum(M)
Do While S  SollSumme
If S  SollSumme Then
Do
zMi = Application.WorksheetFunction.RandBetween(LBound(M), UBound(M))
Loop While M(zMi) = KZahl
M(zMi) = M(zMi) - 1
End If
S = Application.WorksheetFunction.Sum(M)
Loop
'Ausgabe
For Mi = LBound(M) To UBound(M)
WS.Cells(AusgabeZeile + Mi, 1) = M(Mi)
Next Mi
Aufräumen:
Set WS = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Hi Paul
hast du dir die anderen Lösungen auch schon mal angeschaut?
wenns Probleme gibt, ein Ergebnis zu finden, solltest du auch folgendes bedenken:
Zufallszahlen, die zwischen X und Y liegen, werden im Mittelwert mit sehr hoher Wahrscheinlichkeit einen Wert ergeben, der auch genau in der Mitte zwischen X und Y liegt. Je weiter weg ein Ergebnis von dieser liegt, um so weniger wahrscheinlich ist es, dh es wird dann durch Zufallszahlen seltener getroffen
Dividiere also A4 durch A3 und Vergleiche diesen Wert mit A2 und A3.
Er sollte möglichst in der Mitte zwischen beiden Werten liegen.
je mehr er sich dem Min oder Max annähert, um so unwahrscheinlicher wird ein ein zufälliges Ergebnis und um so mehr Versuche wirst du brauchen, wenn du auf echten Zufall setzte.
du brauchst dann also entweder von Hand nachbearbeitete Werte, oder du müsstest das Min oder das Max so anpassen, dass der Quotient aus Zielsumme und Anzahl wieder in der Mitte zwischen beiden liegt.
eine gewichtete Zufallsberechnung (mach Zufallszahlen, die zu 10% aus Werten zwischen 1 und 10, zu 20% aus werten zwischen 11 und 70 und zu 70% aus Werten zwischen 71 und 100 bestehen) gibt es in VBA als vorgefertigte Funktion nicht.
Gruß Daniel

dim i as long Columns(5).ClearContents For i = 1 to 10000 If Range("C1") = " i.O." then Exit for Application.Calculate Next If i > 10000 then Msgbox "keine Lösung gefunden", vbExclamation Else Msgbox " Ergebnis liegt vor" With Range("B1"). Resize(Range("A1"). Value) .offset(0, 3).value = .value End with End if

Beliebteste Forumthreads (12 Monate)

40 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

40
Beiträge zum Forumthread

Beiträge zu diesem Forumthread