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.
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]