Salut tout le monde,
Autant dire tout de suite que VBA est un peu nouveau pour moi mais bon j'ai d'autres concepts de programmation. En ce moment, je suis en stage et j'aimerai trouver par maximum de vraisemblance les paramètres d'un modèle GARCH à l'aide de l'algorithme de Nelder-Mead.

J'espère que vous êtres toujours là..

Donc dans ma feuille excel j ai 3 colonnes et 2518 lignes. Les 2 premières lignes sont inintéressantes (nom des variables). Ensuite, j ai 2515 données par colonne. Celles qui m'interesssent ce sont celles dans la dernière colonne: 2515 rendements d'actions.

Le code que j'utilise proviens de bouquins sur l'utilisation de VBA en finance, en voila un:

http://books.google.com/books?id=xs2...%20vba&f=false

Bref, je n'ai rien en sortie sur ma feuille excel et ca me rend un peu fou parce que je bosse depuis 3 jours dessus et je pense qu'il y a encore quelques petits bugs que je ne vois pas. Si vous en voyez un, dites le moi, ca sera deja ca de fait.

Merci d'avance


Voila mon code:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
 
'BubSortRows
Function BubSortRows(passVec)
Dim tmpVec() As Double, temp() As Double
uVec = passVec
rownum = UBound(uVec, 1)
colnum = UBound(uVec, 2)
ReDim tmpVec(rownum, colnum) As Double
ReDim temp(colnum) As Double
For i = rownum - 1 To 1 Step -1
     For j = 1 To i
      If (uVec(j, 1) > uVec(j + 1, 1)) Then
         For k = 1 To colnum
             temp(k) = uVec(j + 1, k)
             uVec(j + 1, k) = uVec(j, k)
             uVec(j, k) = temp(k)
         Next k
     End If
     Next j
Next i
BubSortRows = uVec
End Function
 
 
'GARCH Likelihood
Function GARCHMLE(rets, startParams)
Dim VAR() As Double
 
 
n = Application.Count(rets)
ReDim VARt(n) As Double
omega = startParams(1)
alpha = startParams(2)
beta = startParams(3)
'Error Checking
If ((omega < 0) Or (alpha < 0) Or (beta < 0)) Then
GARCHMLE1 = -9999
Else
VARt(n) = Application.VAR(rets)
GARCHMLE = -Log(VARt(n)) - (rets(n) ^ 2 / VARt(n))
For cnt = n - 1 To 1 Step -1
VARt(cnt) = omega + alpha * rets(cnt + 1) ^ 2 + beta * VARt(cnt + 1)
GARCHMLE = GARCHMLE - Log(VARt(cnt)) - (rets(cnt) ^ 2 / VARt(cnt))
Next cnt
End If
GARCHMLE = -GARCHMLE
End Function
 
'Finds GARCH MLEs
Function GARCHparams(rets, startParams) As Variant()
     GARCHparams = NelderMead("GARCHMLE", rets, startParams)
End Function
'Nelder.Mead Algorithm
Function NelderMead(fname As String, rets, startParams)
     Dim resMatrix() As Double
     Dim x1() As Double, xn() As Double, xw() As Double, xbar() As Double, xr() As Double, xe() As Double, xc() As Double, xcc() As Double
     Dim funRes() As Double, passParams() As Double
     MAXFUN = 1000
     TOL = 0.0000000001
     rho = 1
     Xi = 2
     gam = 0.5
     sigma = 0.5
     paramnum = Application.Count(startParams)
     ReDim resmat(paramnum + 1, paramnum + 1) As Double
     ReDim x1(paramnum) As Double, xn(paramnum) As Double, xw(paramnum) As Double, xbar(paramnum) As Double, xr(paramnum) As Double, xe(paramnum) As Double, xc(paramnum) As Double, xcc(paramnum) As Double
     ReDim funRes(paramnum + 1) As Double, passParams(paramnum)
     For i = 1 To paramnum
     resmat(1, i + 1) = startParams(i)
     Next i
     resmat(1, 1) = Run(fname, rets, startParams)
     For j = 1 To paramnum
     For i = 1 To paramnum
     If (i = j) Then
     If (startParams(i) = 0) Then
     resmat(j + 1, i + 1) = 0.05
     Else
     resmat(j + 1, i + 1) = startParams(i) * 1.05
     End If
     Else
     resmat(j + 1, i + 1) = startParams(i)
     End If
     passParams(i) = resmat(j + 1, i + 1)
     Next i
     resmat(j + 1, 1) = Run(fname, rets, passParams)
     Next j
     For Inum = 1 To MAXFUN
     resmat = BubSortRows(resmat)
     If (Abs(resmat(1, 1) - resmat(paramnum + 1, 1)) < TOL) Then
     Exit For
     End If
     f1 = resmat(1, 1)
     For i = 1 To paramnum
     x1(i) = resmat(1, i + 1)
     Next i
     fn = resmat(paramnum, 1)
     For i = 1 To paramnum
     xn(i) = resmat(paramnum, i + 1)
     Next i
     fw = resmat(paramnum + 1, 1)
     For i = 1 To paramnum
     xw(i) = resmat(paramnum + 1, i + 1)
     Next i
     For i = 1 To paramnum
     xbar(i) = 0
     For j = 1 To paramnum
     xbar(i) = xbar(i) + resmat(j, i + 1)
     Next j
     xbar(i) = xbar(i) / paramnum
     Next i
     For i = 1 To paramnum
     xr(i) = xbar(i) + rho * (xbar(i) - xw(i))
     Next i
     fr = Run(fname, rets, xr)
     shrink = 0
     If ((fr >= f1) And (fr < fn)) Then
     newpoint = xr
     newf = fr
     ElseIf (fr < f1) Then
'calculate expansion point
     For i = 1 To paramnum
     xe(i) = xbar(i) + Xi * (xr(i) - xbar(i))
     Next i
     fe = Run(fname, rets, xe)
     If (fe < fr) Then
     newpoint = xe
     newf = fe
     Else
     newpoint = xr
     newf = fr
     End If
     ElseIf (fr >= fn) Then
     If ((fr >= fn) And (fr < fw)) Then
     For i = 1 To paramnum
     xc(i) = xbar(i) + gam * (xr(i) - xbar(i))
     Next i
     fc = Run(fname, rets, xc)
     If (fc <= fr) Then
     newpoint = xc
     newf = fc
     Else
     shrink = 1
     End If
     Else
     For i = 1 To paramnum
     xcc(i) = xbar(i) - gam * (xbar(i) - xw(i))
     Next i
     fcc = Run(fname, rets, xcc)
     If (fcc < fw) Then
     newpoint = xcc
     newf = fcc
     Else
     shrink = 1
     End If
     End If
     End If
     If (shrink = 1) Then
     For scnt = 2 To paramnum + 1
     For i = 1 To paramnum
     resmat(scnt, i + 1) = x1(i) + sigma * (resmat(scnt, i + 1) - x1(1))
     passParams(i) = resmat(scnt, i + 1)
     Next i
     resmat(scnt, 1) = Run(fname, rets, passParams)
     Next scnt
     Else
     For i = 1 To paramnum
     resmat(paramnum + 1, i + 1) = newpoint(i)
     Next i
     resmat(paramnum + 1, 1) = newf
     End If
     Next Inum
     If (Inum = MAXFUN + 1) Then
     MsgBox "Maximum Iteration (" & MAXFUN & ") exeeeded"
     End If
     resmat = BubSortRows(resmat)
     For i = 1 To paramnum + 1
     funRes(i) = resmat(1, i)
     Next i
     funRes(1) = funRes(1)
     NelderMead = Application.Transpose(funRes)
     End Function
 
Sub garch()
Dim WS(1) As Worksheet
Set WS(1) = ThisWorkbook.Worksheets("histo S&P500")
Dim i As Integer
Dim rets() As Double
ReDim rets(1 To 10)
For i = 1 To 10
rets(i) = WS(1).Cells(2 + i, 3)
Next i
 
Dim startParams() As Double
ReDim startParams(1 To 3)
startParams(1) = 0.0001
startParams(2) = 0.1
startParams(3) = 1
 
 
 
WS(1).Cells(1, 1) = GARCHparams(rets, startParams)
 
 
End Sub