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.

sbGrowthSeries

Appendix – Programmcode sbGrowthSeries

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbGrowthSeries(dblRate As Double, _
       dblMaxRatePerStep As Double, _
       Optional dblStartVal As Double = 1#) As Variant
'Returns random data with a compound growth rate dblRate, with
'a maximal relative change rate per step of dblMaxRatePerStep
'and with a start value dblStartVal. The number of periods
'is implicitly chosen by the number of selected cells which
'call this function as an array formula (entered with
'CTRL + SHIFT + ENTER). This is sort of a brownian bridge.
'Source (EN): http://www.sulprobil.de/sbgrowthseries_en/
'Source (DE): http://www.berndplumhoff.de/sbgrowthseries_de/
'(C) (P) by Bernd Plumhoff 20-Mar-2011 PB V0.91

Dim vR As Variant
Dim lP As Long 'Periods
Dim lrow As Long
Dim lcol As Long
Dim dblCurrVal As Double
Dim dblCurrRate As Double
Dim dblCurrMin As Double
Dim dblCurrMax As Double
Dim dblRelMin As Double
Dim dblRelMax As Double
Dim dblEndVal As Double

Application.Volatile

If TypeName(Application.Caller) <> "Range" Then
    sbGrowthSeries = CVErr(xlErrRef)
    Exit Function
End If

If Application.Caller.Rows.Count <> 1 And _
    Application.Caller.Columns.Count <> 1 Then
    sbGrowthSeries = CVErr(xlErrValue)
    Exit Function
End If

If Abs(dblRate) > dblMaxRatePerStep Then
    sbGrowthSeries = CVErr(xlErrNum)
    Exit Function
End If

lP = Application.Caller.Count

ReDim vR(1 To Application.Caller.Rows.Count, _
               1 To Application.Caller.Columns.Count)

dblCurrVal = dblStartVal
dblEndVal = dblStartVal * (1# + dblRate) ^ CDbl(lP)
dblCurrMin = dblEndVal / (1# + dblMaxRatePerStep) ^ CDbl(lP)
dblCurrMax = dblEndVal / (1# - dblMaxRatePerStep) ^ CDbl(lP)
For lrow = 1 To UBound(vR, 1)
    For lcol = 1 To UBound(vR, 2)
        dblCurrRate = (dblEndVal / dblCurrVal) ^ _
            (1# / CDbl(lP - lcol * lrow + 1)) - 1#
        dblCurrMin = dblCurrMin * (1# + dblMaxRatePerStep)
        dblCurrMax = dblCurrMax * (1# - dblMaxRatePerStep)
        dblRelMin = (dblCurrMin - dblCurrVal) / dblCurrVal
        If dblRelMin < -dblMaxRatePerStep Then
            dblRelMin = -dblMaxRatePerStep
        End If
        dblRelMax = (dblCurrMax - dblCurrVal) / dblCurrVal
        If dblRelMax > dblMaxRatePerStep Then
            dblRelMax = dblMaxRatePerStep
        End If
        If dblCurrRate - dblRelMin < dblRelMax - dblCurrRate Then
            dblRelMax = 2# * dblCurrRate - dblRelMin
        Else
            dblRelMin = 2# * dblCurrRate - dblRelMax
        End If
        dblCurrVal = dblCurrVal * (1# + (dblRelMin + dblRelMax) / _
                    2# + (Rnd() - 0.5) * (dblRelMax - dblRelMin))
        vR(lrow, lcol) = dblCurrVal
    Next lcol
Next lrow

sbGrowthSeries = vR

End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbGrowthSeries.xlsm [83 KB Excel Datei, ohne jegliche Gewährleistung]