-
Notifications
You must be signed in to change notification settings - Fork 0
/
monte_carlo_macro.txt
117 lines (99 loc) · 2.98 KB
/
monte_carlo_macro.txt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
Sub monte_carlo()
Dim Arr(2) As Single
Dim Std_Dev As Single
Dim Cal_Error As Single
Dim Cal_Num As Single
Dim Cal_Avg As Single
Dim percentage As Single
percentage = Worksheets("Sheet1").Range("D2").Value
Debug.Print "Pecentage: "; percentage
Application.ScreenUpdating = False
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
minArray = getData(NumRows, "B")
minArraySum = getSum(minArray)
Debug.Print minArraySum
maxArray = getData(NumRows, "C")
maxArraySum = getSum(maxArray)
Debug.Print maxArraySum
Arr(0) = minArraySum
Arr(1) = maxArraySum
Std_Dev = stddev(2, Arr)
Debug.Print "StdDev: "; Std_Dev
Range("E1").Value = "Sigma"
Range("E2").Value = Std_Dev
Cal_Error = CalError(Arr, percentage)
Debug.Print "Error: "; Cal_Error
Range("F1").Value = "Error"
Range("F2").Value = Cal_Error
Cal_Num = CalNum(Std_Dev, Cal_Error, percentage)
Debug.Print "Number: "; Cal_Num
Range("G1").Value = "N"
Range("G2").Value = Cal_Num
Cal_Avg = CalAvg(Cal_Num, Arr)
Debug.Print "Avg: "; Cal_Avg
Range("H1").Value = "Average"
Range("H2").Value = Cal_Avg
Application.ScreenUpdating = True
End Sub
Public Function getData(ByVal num As Integer, ByVal row As String) As Variant()
ReDim returnVal(num)
Dim i As Integer
Dim result As String
For x = 2 To num
result = Range(row & x)
If result <> "" Then
ActiveCell.Offset(1, 0).Select
returnVal(i) = result
i = i + 1
End If
Next
getData = returnVal
End Function
Public Function getSum(ByVal inputArray As Variant) As Double
Dim Sum As Double
For Each element In inputArray
Sum = Sum + element
Next element
getSum = Sum
End Function
Function Mean(k As Long, Arr() As Single)
Dim Sum As Single
Dim i As Integer
Sum = 0
For i = 1 To k
Sum = Sum + Arr(i)
Next i
Mean = Sum / k
End Function
Function stddev(k As Long, Arr() As Single)
Dim i As Integer
Dim avg As Single, SumSq As Single
avg = Mean(k, Arr)
For i = 1 To k
SumSq = SumSq + (Arr(i) - avg) ^ 2
Next i
stddev = Sqr(SumSq / (k - 1))
End Function
Function CalError(Arr() As Single, ByVal percentage As Long)
Dim error As Single
error = (Arr(1) - Arr(0)) * (percentage / 100)
CalError = error
End Function
Function CalNum(sigma As Single, error As Single, ByVal percentage As Long)
Dim result As Single
result = (percentage * sigma) / error
result = result * result
CalNum = result
End Function
Function CalAvg(number As Single, Arr() As Single)
Dim result As Single
ReDim result_arr(number) As Variant
For i = 1 To number:
r = Int((1 - 0 + 1) * Rnd + 0) * (Arr(1) - Arr(0)) + Arr(0)
result_arr(i) = r
Next i
arraySum = WorksheetFunction.Sum(result_arr)
arrayLen = UBound(result_arr) - LBound(result_arr) + 1
result = arraySum / arrayLen
CalAvg = result
End Function