Random Numbers on Bernd Plumhoff

sbRandGeneral (VBA)

Thu, 14 May 2026 16:01:00 +0100

“It pays to be obvious, especially if you have a reputation for subtlety.” [Isaac Asimov]

Abstract

Wenn Sie eine schrittweise lineare Verteilung von Zufallszahlen benötigen, dann empfehle ich meine benutzerdefinierte Funktion sbRandGeneral.

Bemerkung: Man kann jede beliebige Verteilung mit einer festgelegten Mindestgenauigkeit durch eine schrittweise lineare Verteilung wie hier angeboten approximieren.

Dokumentation

Die Dokumentation zu dieser Funktion:

Bitte den Haftungsausschluss im Impressum beachten.

080102_PB_01_General_Doc.pdf [30 KB PDF Datei, ohne Gewähr]

sbRandTrigen (VBA)

Thu, 14 May 2026 15:47:00 +0100

Abstract

Bitte beachten dass sbRandTrigen sbRandTriang benötigt und aufruft.

Dokumentation

Die Dokumentation zu dieser Funktion:

Bitte den Haftungsausschluss im Impressum beachten.

071228_PB_02_Trigen_Doc.pdf [38 KB PDF Datei, ohne Gewähr]

Appendix – Programmcode sbRandTrigen

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbRandTrigen(dBottom As Double, dMode As Double, _
    dTop As Double, dBottomPerc As Double, _
    dTopPerc As Double, Optional dRandom = 1#) As Double
'Generates dMin random number, Triang distributed
'with given first and last decile
'[see Vose: Risk Analysis, 2nd ed., p. 129]
'Source (EN): http://www.sulprobil.de/sbrandgeneral_en/
'Source (DE): http://www.berndplumhoff.de/sbrandgeneral_de/
'(C) (P) by Bernd Plumhoff 19-Nov-2011 PB V0.32
'Similar to @RISK's (C) RiskTrigen function.
'sbRandTrigen(bottom, mode, top, bottom percentile, top percentile)
'specifies a triangular distribution with three points — one
'at the mode and two at the specified bottom and top percentiles.
'The bottom percentile and top percentile are values between
'0 and 100. Each percentile value gives the percentile of the
'total area under the triangle that is on the left side of the
'given point.
'Example:
'sbRandTrigen(1,8,10,20,95) will call
'sbRandTriang(-6.13212712795534, 8, 11.8648937411641).
'Please ensure that you execute Randomize before you call 
'this function for the first time.

Static dBottomLast As Double
Static dModeLast As Double
Static dTopLast As Double
Static dBottomPercLast As Double
Static dTopPercLast As Double
Static dMin As Double
Static dMax As Double
Dim dMaxNew As Double
Dim da0 As Double, da1 As Double, da2 As Double
Dim da3 As Double, da4 As Double
Dim dfe As Double, df1e As Double
Dim dBottomPerc2 As Double, dTopPerc2 As Double
Dim i As Long

If dBottom = dBottomLast And dMode = dModeLast And dTop = dTopLast _
   And dBottomPerc = dBottomPercLast And dTopPerc = dTopPercLast _
   And Not IsError(dMin) Then
    sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
    Exit Function
End If

dBottomLast = dBottom
dModeLast = dMode
dTopLast = dTop
dBottomPercLast = dBottomPerc
dTopPercLast = dTopPerc

dBottomPerc2 = dBottomPerc / 100#
dTopPerc2 = 1# - dTopPerc / 100#
If dMode <= dBottom Or dTop <= dMode Then
    dMin = CVErr(xlErrValue) 'Trigger rerun next time
    sbRandTrigen = CVErr(xlErrValue)
    Exit Function
End If
If dBottomPerc2 < 0# Or dTopPerc2 < 0# Then
    dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
    sbRandTrigen = CVErr(xlErrValue)
    Exit Function
End If

If dTopPerc2 = 0# Then
    If dBottomPerc2 = 0# Then
        sbRandTrigen = sbRandTriang(dBottom, dMode, dTop, dRandom)
        Exit Function
    End If
    sbRandTrigen = sbRandTrigen(dBottom, dMode, dTop, dBottomPerc2, dTopPerc2)
    Exit Function
End If

da4 = dBottomPerc2 * dTopPerc2 - dBottomPerc2 + 1# - 2# * dTopPerc2 + dTopPerc2 ^ 2#
da3 = -2# * dBottomPerc2 * dTopPerc2 * dTop - 2# * dBottomPerc2 * dTopPerc2 * dMode - _
      4# * dTop + 4# * dBottomPerc2 * dTop + 2# * dTopPerc2 * dMode + 4# * dTopPerc2 * _
      dTop + 2# * dTopPerc2 * dBottom - 2# * dTopPerc2 ^ 2# * dMode - _
      2# * dTopPerc2 ^ 2# * dBottom
da2 = dBottomPerc2 * dTopPerc2 * dTop ^ 2# + 4# * dBottomPerc2 * dTopPerc2 * dMode * _
      dTop + dBottomPerc2 * dTopPerc2 * dMode ^ 2# - 6# * dBottomPerc2 * dTop ^ 2# + _
      6# * dTop ^ 2# - 4# * dTopPerc2 * dMode * dTop - 2# * dTopPerc2 * dTop ^ 2# - 2# * _
      dTopPerc2 * dBottom * dMode - 4# * dTopPerc2 * dBottom * dTop + dTopPerc2 ^ 2# * _
      dMode ^ 2# + 4# * dTopPerc2 ^ 2# * dBottom * dMode + dTopPerc2 ^ 2# * dBottom ^ 2#
da1 = -2# * dBottomPerc2 * dTopPerc2 * dMode * dTop ^ 2# - 2# * dBottomPerc2 * dTopPerc2 * _
      dMode ^ 2# * dTop + 4# * dTop ^ 3# * dBottomPerc2 - 4# * dTop ^ 3# + 2# * dTopPerc2 * _
      dMode * dTop ^ 2# + 4# * dTopPerc2 * dBottom * dMode * dTop + 2# * dTopPerc2 * _
      dBottom * dTop ^ 2# - 2# * dTopPerc2 ^ 2# * dBottom * dMode ^ 2# - 2# * _
      dTopPerc2 ^ 2# * dBottom ^ 2# * dMode
da0 = dBottomPerc2 * dTopPerc2 * dMode ^ 2# * dTop ^ 2# - dBottomPerc2 * dTop ^ 4# + dTop ^ 4# - _
      2# * dTopPerc2 * dBottom * dMode * dTop ^ 2# + dTopPerc2 ^ 2# * dBottom ^ 2# * dMode ^ 2#
     
dMax = dTop + (dTop - dMode) / (1# - dTopPerc2) ^ 2#

'Newton iteration
Do While Abs(dMaxNew - dMax) > 0.000000000001

    i = i + 1
    If i > 30 Then
        If Abs(dfe) > 0.000000000001 Then
            dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
            sbRandTrigen = CVErr(xlErrValue)
            Exit Function
        Else
            Exit Do
        End If
    End If
    dMaxNew = dMax
    dfe = da4 * dMaxNew ^ 4# + da3 * dMaxNew ^ 3# + da2 * dMaxNew ^ 2# + da1 * dMaxNew + da0
    df1e = 4# * da4 * dMaxNew ^ 3# + 3# * da3# * dMaxNew ^ 2# + 2# * da2 * dMaxNew + da1
    dMax = dMax - dfe / df1e

Loop

dMin = dMax - (dMax - dTop) ^ 2# / dTopPerc2 / (dMax - dMode)
sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbRandTriang (VBA)

Thu, 14 May 2026 14:47:00 +0100

Abstract

Die Dreiecksverteilung ist eine stetige Wahrscheinlichkeitsverteilung, deren Dichtefunktion wie ein Dreieck aussieht. Es ist eine einfache Verteilung, weil Sie lediglich ihr Minimum, ihren Median und ihr Maximum kennen müssen:

Im englischen Sprachraum wird diese Verteilung auch Distribution of Missing Data genannt, weil für ihre Bestimmung nur ein Minimum an Information benötigt wird. Diese Verteilung wird oft zur Simulation von Expertenwissen eingesetzt oder wenn eine genauere Datenermittlung zu schwierig oder zu teuer erscheint.

sbRandSum1 (VBA)

Thu, 14 May 2026 12:40:00 +0100

Abstract

Wir erzeugen n Zufallszahlen mit einer Bedingung: Die Summe aller erzeugten Zahlen soll 1 sein. Dies kann man mit vielen verschiedenen Ansätzen erreichen.

Drei mögliche Ansätze sind:

Reduziere den Freiheitsgrad sukzessive: Erzeuge die erste Zufallszahl, danach die zweite im Bereich [0,1-Erste_Zahl), dann die dritte [0,1-Erste_Zahl-Zweite_Zahl), …, die letzte Zahl muss schließlich gleich 1-Summe_aller_anderen_Zahlen sein.
Erzeuge n Zufallszahlen und dividiere sie durch ihre Summe.
Simuliere die Teilung einer Torte: wo immer man schneidet, man kann nicht mehr und nicht weniger als die ganze Torte verteilen.

sbRandIntFixSum (VBA)

Thu, 14 May 2026 11:46:00 +0100

Abstract

Sie wollen lCount ganze Zufallszahlen zwischen lMin und lMax mit der Summe lSum erzeugen?

Diese benutzerdefinierte Funktion ist eng mit sbLongRandSumN verwandt.

Appendix Programmcode sbRandIntFixSum

Dieses Programm benötigt (ruft auf) sbRandTriang.

Bitte den Haftungsausschluss im Impressum beachten.

Function sbRandIntFixSum(lSum As Long, lMin As Long, _
  lMax As Long, Optional lCount As Long = 0, _
  Optional bUseRandTriang As Boolean = True, _
  Optional bVolatile As Boolean = False) As Variant
'Returns lCount (or selected cell count in case a range is select when
'called as a matrix formula) random integers between lMin and lMax
'which sum up to lSum. If bUseRandTriang the sbRandTriang distribution
'is used to "bias" the randomness to be "less extreme".

'Error values:
'#NUM!   - No solution exists
'#VALUE! - lCount is less than 1
'Source (EN): https://www.sulprobil.de/sbrandintfixsum_en/
'Source (DE): https://www.berndplumhoff.de/sbrandintfixsum_de/
'(C) (P) by Bernd Plumhoff 05-Aug-2020 PB V0.3

Dim i As Long
Dim lRnd As Long, lMinPrev As Long
Dim lRow As Long, lCol As Long

With Application

If TypeName(.Caller) = "Range" And lCount = 0 Then
  lCount = .Caller.Count
  ReDim lR(1 To .Caller.Rows.Count, 1 To .Caller.Columns.Count) As Long
ElseIf lCount < 1 Then
  sbRandIntFixSum = CVErr(xlErrValue)
  Exit Function
Else
  ReDim lR(1 To lCount, 1 To 1) As Long
End If

Randomize
If bVolatile Then .Volatile

For lRow = 1 To UBound(lR, 1)
  For lCol = 1 To UBound(lR, 2)
    lMinPrev = lMin
    lMin = .RoundUp(.Max(lMin, .Min(lSum / lCount, lSum / lCount _
           - (lCount - 1) * (lMax - lSum / lCount))), 0)
    lMax = .RoundDown(.Min(lMax, .Max(lSum / lCount, lSum / lCount _
           + (lCount - 1) * (lSum / lCount - lMinPrev))), 0)
    If lMin > lMax Or lSum / lCount <> .Median(lMin, lMax, lSum / lCount) Then
      'No solution exists
      sbRandIntFixSum = CVErr(xlErrNum)
      Exit Function
    End If
    If bUseRandTriang Then
      If lMin = lMax Then
        lRnd = lMin
      Else
        lRnd = Int(sbRandTriang(CDbl(lMin), lSum / lCount, CDbl(lMax)) + 0.5)
      End If
    Else
      lRnd = Int(Rnd() * (lMax - lMin + 1) + lMin)
    End If
    lR(lRow, lCol) = lRnd
    lSum = lSum - lRnd
    lCount = lCount - 1
  Next lCol
Next lRow

sbRandIntFixSum = lR
End With

End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbGrowthSeries (VBA)

Thu, 14 May 2026 10:47:00 +0100

Abstract

Sie können Zufallszahlen mit einer kumulierten Wachstumsrate dblRate, mit einer maximalen relativen Änderungsrate pro Zeitschritt dblMaxRatePerStep und mit einem optionalen Startwert dblStartVal erzeugen. Die Anzahl der Zeitschritte (Perioden) wird implizit durch die Anzahl der ausgewählten Zellen gewählt, in die der Funktionsaufruf als Matrixformel mit STRG + SHIFT + ENTER eingegeben wird. Dies ist eine spezielle Art von Brownscher Brücke.

Appendix – Programmcode sbGrowthSeries

Bitte den Haftungsausschluss im Impressum beachten.

sbRandHistogrm (VBA)

Thu, 14 May 2026 06:46:00 +0100

Abstract

Appendix Programmcode sbRandHistogrm

Bitte den Haftungsausschluss im Impressum beachten.

Function sbRandHistogrm(dmin As Double, dMax As Double, _
            vWeight As Variant, Optional dRandom = 1#) As Double
'Specifies a histogram distribution with range dmin:dmax.
'This range is divided into vWeight.count classes. Each
'class has weight vWeight(i) reflecting the probability
'of occurrence of a value within the class.
'Similar to @Risk's function RiskHistogrm.
'Source (EN): http://www.sulprobil.de/sbrandhistogrm_en/
'Source (DE): http://www.berndplumhoff.de/sbrandhistogrm_de/
'(C) (P) by Bernd Plumhoff 18-Oct-2020 PB V1.01

Dim i As Long, n As Long, vW As Variant
Dim dRand As Double, dR As Double, dSumWeight As Double

With Application.WorksheetFunction
vW = .Transpose(.Transpose(vWeight))
End With

n = UBound(vW)
ReDim dSumWeightI(0 To n) As Double
   
dSumWeight = 0#
dSumWeightI(0) = 0#
For i = 1 To n
    If vW(i) < 0# Then 'A negative weight is an error
        sbRandHistogrm = CVErr(xlErrValue)
        Exit Function
    End If
    dSumWeight = dSumWeight + vW(i) 'Calculate sum of all weights
    dSumWeightI(i) = dSumWeight     'Calculate sum of weights till i
Next i

If dSumWeight = 0# Then  'Sum of weights has to be greater than zero
    sbRandHistogrm = CVErr(xlErrValue)
    Exit Function
End If

If dRandom = 1# Then
    dRand = Rnd()
Else
    dRand = dRandom
End If
dR = dSumWeight * dRand

i = n
Do While dR < dSumWeightI(i)
    i = i - 1
Loop

sbRandHistogrm = dmin + (dMax - dmin) * _
     (CDbl(i) + (dR - dSumWeightI(i)) / vW(i + 1)) / CDbl(n)

End Function

Bitte den Haftungsausschluss im Impressum beachten.

sbLongRandSumN (VBA)

Thu, 14 May 2026 05:46:00 +0100

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:

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.