Sulprobil
Search…
sbGrowthSeries
Please read my Disclaimer.
1
Option Explicit
2
3
Function sbGrowthSeries(dblRate As Double, _
4
dblMaxRatePerStep As Double, _
5
Optional dblStartVal As Double = 1#) As Variant
6
'Returns random data with a compound growth rate dblRate, with
7
'a maximal relative change rate per step of dblMaxRatePerStep
8
'and with a start value of dblStartVal. The number of periods
9
'is implicitly chosen by the number of selected cells which
10
'call this function as an array formula (entered with
11
'CTRL + SHIFT + ENTER). This is sort of a brownian bridge.
12
'Reverse("moc.LiborPlus.www") V0.91 PB 20-Mar-2011
13
14
Dim vR As Variant
15
Dim lP As Long 'Periods
16
Dim lrow As Long
17
Dim lcol As Long
18
Dim dblCurrVal As Double
19
Dim dblCurrRate As Double
20
Dim dblCurrMin As Double
21
Dim dblCurrMax As Double
22
Dim dblRelMin As Double
23
Dim dblRelMax As Double
24
Dim dblEndVal As Double
25
26
Application.Volatile
27
28
If TypeName(Application.Caller) <> "Range" Then
29
sbGrowthSeries = CVErr(xlErrRef)
30
Exit Function
31
End If
32
33
If Application.Caller.Rows.Count <> 1 And _
34
Application.Caller.Columns.Count <> 1 Then
35
sbGrowthSeries = CVErr(xlErrValue)
36
Exit Function
37
End If
38
39
If Abs(dblRate) > dblMaxRatePerStep Then
40
sbGrowthSeries = CVErr(xlErrNum)
41
Exit Function
42
End If
43
44
lP = Application.Caller.Count
45
46
ReDim vR(1 To Application.Caller.Rows.Count, _
47
1 To Application.Caller.Columns.Count)
48
49
dblCurrVal = dblStartVal
50
dblEndVal = dblStartVal * (1# + dblRate) ^ CDbl(lP)
51
dblCurrMin = dblEndVal / (1# + dblMaxRatePerStep) ^ CDbl(lP)
52
dblCurrMax = dblEndVal / (1# - dblMaxRatePerStep) ^ CDbl(lP)
53
For lrow = 1 To UBound(vR, 1)
54
For lcol = 1 To UBound(vR, 2)
55
dblCurrRate = (dblEndVal / dblCurrVal) ^ _
56
(1# / CDbl(lP - lcol * lrow + 1)) - 1#
57
dblCurrMin = dblCurrMin * (1# + dblMaxRatePerStep)
58
dblCurrMax = dblCurrMax * (1# - dblMaxRatePerStep)
59
dblRelMin = (dblCurrMin - dblCurrVal) / dblCurrVal
60
If dblRelMin < -dblMaxRatePerStep Then
61
dblRelMin = -dblMaxRatePerStep
62
End If
63
dblRelMax = (dblCurrMax - dblCurrVal) / dblCurrVal
64
If dblRelMax > dblMaxRatePerStep Then
65
dblRelMax = dblMaxRatePerStep
66
End If
67
If dblCurrRate - dblRelMin < dblRelMax - dblCurrRate Then
68
dblRelMax = 2# * dblCurrRate - dblRelMin
69
Else
70
dblRelMin = 2# * dblCurrRate - dblRelMax
71
End If
72
dblCurrVal = dblCurrVal * (1# + (dblRelMin + dblRelMax) / _
73
2# + (Rnd() - 0.5) * (dblRelMax - dblRelMin))
74
vR(lrow, lcol) = dblCurrVal
75
Next lcol
76
Next lrow
77
78
sbGrowthSeries = vR
79
80
End Function
Copied!
Last modified 1yr ago
Copy link