Abstract

Sie benötigen 20 natürliche Zufallszahlen mit der Summe 100? Dann schlage ich meine hier gezeigte benutzerdefinierte Funktion vor. Sie können beliebig viele ganze Zahlen mit einer vorgegebenen Summe erzeugen, wobei die erzeugten Zahlen ein spezifiertes Minimum nicht unterschreiten dürfen:

sbLongRandSumN_Screen

Bitte beachten Sie, dass diese Funktion mit sbRandIntFixSum verwandt ist, bei der Minimum und Maximum vorgegeben werden, sowie mit der Brown’schen Brücke sbGrowthSeries, und mit sbRandSum1 welche doppelt-genaue Zahlen mit der Summe 1 erzeugt. Diese Funktion wird auch von der Anwendung sbGenerateTestData verwendet.

Appendix Programmcode sbLongRandSumN

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbLongRandSumN(lSum As Long, _
    ByVal lCount As Long, _
    Optional ByVal lMin As Long = 0) As Variant
'Generates lCount random integers greater equal lMin
'which sum up to lSum.
'Source (EN): https://www.sulprobil.com/sblongrandsumn_en/
'Source (DE): https://www.bplumhoff.de/sblongrandsumn_de/
'(C) (P) by Bernd Plumhoff 26-Apr-2013 PB V0.1
Dim i As Long
Dim lSumRest As Long

If lCount * lMin > lSum Then
    sbLongRandSumN = CVErr(xlErrNum)
    Exit Function
End If
If lCount < 1 Then
    sbLongRandSumN = CVErr(xlErrValue)
    Exit Function
End If
Randomize
ReDim vR(1 To lCount) As Variant
lSumRest = lSum
For i = lCount To 2 Step -1
    vR(i) = lMin + Int(Rnd * (lSumRest - lMin * i))
    lSumRest = lSumRest - vR(i)
Next i
vR(1) = lSumRest
sbLongRandSumN = vR
End Function

Sub Test_sbLongRandSumN()
Dim i As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
ws.Range("A2:N102").ClearContents
For i = 2 To 101
    ws.Cells(i, 1) = Int(Rnd * 100 + 10)
    ws.Cells(i, 2) = Int(Rnd * 10 + 1)
    ws.Cells(i, 3) = Int(Rnd * ws.Cells(i, 1) / ws.Cells(i, 2))
    ws.Cells(i, 4).FormulaR1C1 = "=SUM(RC[1]:RC[" & ws.Cells(i, 2) & "])"
    Range(ws.Cells(i, 5), ws.Cells(i, ws.Cells(i, 2) + 4)).FormulaArray = _
        "=sbLongRandSumN(A" & i & ",B" & i & ",C" & i & ")"
Next i

End Sub

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbLongRandSumN.xlsm [25 KB Excel Datei, ohne jegliche Gewährleistung]