Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1440to1444
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1440to1444
1440to1444
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

zufällige Zahlen berechnen

zufällige Zahlen berechnen
23.08.2015 12:07:34
Christian

Hallo,
hoffe ihr habt ein schönes Wochenende.
Wollte mal fragen, ob es für folgendes Problem eine Lösung gibt,
ich suche 10 zufällige Zahlen, die addiert 9490,95 ergeben.
jedoch soll keine der Zahlen kleiner als 901,64 und keine größer als 996,54 sein, sowie keine Zahlen mit mehr als 2 Nachkommastellen.
Fällt euch da eine Möglichkeit ein?
Viele Grüße
Christian

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: zufällige Zahlen berechnen
23.08.2015 13:01:27
Sepp
Hallo Christian,
Sub summe()
Dim dblSum(9) As Double, dblRnd As Double, dblTmp As Double
Dim lngI As Long, lngN As Long
Dim vntRet As Variant
Dim strOut As String

Randomize Timer

For lngI = 0 To 9
  dblRnd = Int((99654 - 90164 + 1) * Rnd + 90164) / 100
  dblSum(lngI) = dblRnd
Next

Do While Round(Application.Sum(dblSum), 2) <> 9490.95
  dblTmp = Application.Sum(dblSum)
  If dblTmp > 9490.95 Then
    vntRet = Application.Match(Application.Max(dblSum), dblSum, 0) - 1
    dblSum(vntRet) = Round(Application.Max(901.64, dblSum(vntRet) - (dblTmp - 9490.95)), 2)
  Else
    vntRet = Application.Match(Application.Min(dblSum), dblSum, 0) - 1
    dblSum(vntRet) = Round(Application.Min(996.54, dblSum(vntRet) + (9490.95 - dblTmp)), 2)
  End If
Loop

For lngI = 0 To 9
  strOut = strOut & Format(dblSum(lngI), "0.00") & vbLf
Next

MsgBox strOut & "==========" & vbLf & CStr(Application.Sum(dblSum))

End Sub



Gruß Sepp
Anzeige
AW: zufällige Zahlen berechnen
23.08.2015 13:15:00
Christian
Hallo Sepp, das sieht schonmal sehr gut aus,
nur noch eine Frage, lässt sich das ganze auch in Tabelle2 Spalte A ausgeben statt in einer Message Box?
Danke
Christian

AW: zufällige Zahlen berechnen
23.08.2015 13:38:40
Sepp
Hallo Christian,
klar! Und noch ein paar Anpassungen, um das Ganze flexibler zu gestalten.
Sub summe()
Dim dblSum() As Double, dblRnd As Double, dblTmp As Double
Dim dblMax As Double, dblMin As Double, dblRes As Double
Dim lngI As Long, lngNum As Long
Dim vntRet As Variant

'Einstellungen
dblMin = 901.64   'Kleinste Zahl
dblMax = 996.54   'größte Zahl
dblRes = 9490.95  'Erwartete Summe
lngNum = 10       'Anzahl der Zahlen


'Plausibilitätsprüfung
If dblMax * lngNum < dblRes Or dblMin * lngNum > dblRes Then
  MsgBox "Nicht lösbar!"
  Exit Sub
End If

Redim dblSum(lngNum - 1)

Randomize Timer

For lngI = 0 To lngNum - 1
  dblRnd = Int(((dblMax * 100) - (dblMin * 100) + 1) * Rnd + (dblMin * 100)) / 100
  dblSum(lngI) = dblRnd
Next

Do While Round(Application.Sum(dblSum), 2) <> dblRes
  dblTmp = Application.Sum(dblSum)
  If dblTmp > dblRes Then
    vntRet = Application.Match(Application.Max(dblSum), dblSum, 0) - 1
    dblSum(vntRet) = Round(Application.Max(dblMin, dblSum(vntRet) - (dblTmp - dblRes)), 2)
  Else
    vntRet = Application.Match(Application.Min(dblSum), dblSum, 0) - 1
    dblSum(vntRet) = Round(Application.Min(dblMax, dblSum(vntRet) + (dblRes - dblTmp)), 2)
  End If
Loop

'Ausgabe
Sheets("Tabelle2").Range("A1").Resize(UBound(dblSum) + 1, 1) = Application.Transpose(dblSum)

End Sub



Gruß Sepp
Anzeige
AW: zufällige Zahlen berechnen
23.08.2015 13:44:48
Christian
Hallo Sepp,
vielen vielen DAnk.
So passts
Schönen Restsonntag
Christian

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige