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
| Sub Retraitement_données2()
Dim TheCell As Range
Dim X As Long, Y As Long
Dim Entete As Range
Dim TheSheet As Worksheet
Dim FindedCell As Range
Set TheSheet = Worksheets("Sheet1")
'J'avais oublié les entet de colonne
Set Entete = TheSheet.Range("B4:E4")
'Initialisation de 2 variables (long ou entier selon besoin) X = 0 Y = -1
X = 0
Y = -1
'Une Boucle qui suis les cases une a une en colonne A
For Each TheCell In TheSheet.Range("B5", TheSheet.Cells(Rows.Count, "B").End(xlUp))
'Si valeur dans caseA <> X Alors
If TheCell <> X Then 'On crée une nouvelle colonne de valeur
X = TheCell 'X = Valeur CaseA
Y = Y + 1 'Y = Y + 1
Entete.Copy TheSheet.Cells(3, 10 + Y * 4)
End If 'Fin Si
'caseA + les 3 cases suivantes copiées vers colonne n° 7 (colonne G) + (Y*4) à la suite des données deja existantes
'Il faut juste rechercher la valeur dans la colonne F
'et utiliser le row de cette cellule afin de l'utiliser dans la formule suivante
Set FindedCell = TheSheet.Columns("I").Find(TheCell.Offset(0, 1))
If Not FindedCell Is Nothing Then
TheCell.Resize(1, 4).Copy TheSheet.Cells(FindedCell.row, 10 + Y * 4)
'On remet la couleur par defaut (le cas se presente si la date est rajouter lors d'un 2eme lancement dans la colonne F)
TheCell.Offset(0, 1).Interior.ColorIndex = 45
Else
'La date est introuvable
'On le signale en passant cette dateen rouge
TheCell.Offset(0, 1).Interior.ColorIndex = 3
End If
Next 'Boucle
'For g = 8 To 100 Step 4
'For i = 4 To 1000
'A = Worksheets("sheet2").Cells(i, 2)
'B = Worksheets("sheet1").Cells(4, g)
'If A = B Then
'r = Worksheets("sheet2").Cells(i, 1)
'For t = 1 To 270
'For w = g To g + 3
'u = Worksheets("sheet1").Cells(3 + t, w - 1)
'Worksheets("sheet2").Cells(r + 2 + t, w - 1) = u
'Next w
'Next t
'End If
'Next i
'Next g
Worksheets("sheet1").Activate 'RANDOM EVENT
For i = 0 To 20
Cells(5 + i, 6) = Int((295) * Rnd() + 0)
Next i
'STOCK SELECTION .This macro selects the stocks depending on the event date. It selects the stock only if there is an history of 20 months before the event date
'In the random process of determining the events, we have to be sure that the lower bound will not be equal or less than the
'number of months that we have to take into consideration before the event date.
K = 0
For j = 1 To 4 '10 is the number of sample that we want. We have one event per sample
Sheets("Sheet1").Select
Y = 5 + Cells(5 + j, 6).Value 'I add 3 because it is the number of row from where the dates start
Z = 0
For i = 0 To 36 '6 is the number of stocks that we have
Worksheets("Sheet1").Activate
If Cells(Y - 20, 10 + i) <> 0 And Cells(Y + 10, 10 + i) <> 0 Then '20 is the number of months that we want before the event date
Z = Z + 1
Range(Cells(Y - 20, 10 + i), Cells(Y + 20, 10 + i)).Select '16 is the column number from where we start looking at event date
Selection.Copy
Sheets("StockSelection").Select
Cells(3 + K, Z).Select
ActiveSheet.Paste
Cells(2 + K, Z).Select
Cells(2 + K, Z) = Z
End If
Next i
'NOW WE ARE DRAWING NUMBERS UP TO 5 (it depends how many stock we'd like to have in our sample)
For h = 0 To 5 '5 is the number of stocks in the sample
Sheets("StockSelection").Select
Cells(1 + K, 1 + h) = Int(Z * Rnd() + 1)
Next h
K = K + 44
Next j
'This part is randomly drawing stock whithin the ones that were previously selected
For C = 0 To 175 Step 44
For B = 1 To 6 '6 is the number of stocks that we have in our sample. This number should be h + 1
Sheets("StockSelection").Select
A = Cells(C + 1, B).Value
Range(Cells(3 + C, A), Cells(43 + C, A)).Select
Selection.Copy
Sheets("RndSelection").Select
Cells(1 + C, B).Select
ActiveSheet.Paste
Next B
Next C
'THIS IS THE REGRESSION PART. EVERYTHING GOES FROM SHEET "RNDSELECTION" TO SHEET "REGRESSION"
Dim ligne As Integer
Dim col As Integer
Dim row As Integer
Dim column As Integer
Dim s As Double
Dim p As Double
Dim q As Double
For g = 0 To 131 Step 44 '44 is the gap between 2 time series
ligne = 18 + g '(nb ofcolumns)*(1+nb of factors)
col = 41 ' nb of lines(number of lines of the time series)
ReDim Reg(v, w) As Variant
ReDim data(ligne, col) As Variant
Sheets("RndSelection").Activate
p = -2 + g
q = 0
Sheets("RndSelection").Activate
For j = 1 To 6 '6 is the number of stocks that we have
q = 0
p = p + 3 '3 is the number of factors that we have + 1
For i = 1 To 41 'This is the length of the time serie
If Cells(i + g, j).Value <> "" And Cells(i + g, 52).Value <> "" And Cells(i + g, 53) <> "" Then '52 & 53 are the column numbers where the factors are
s = p
q = q + 1
data(p, q) = Cells(i + g, j).Value
s = s + 1
data(s, q) = Cells(i + g, 52).Value
s = s + 1
data(s, q) = Cells(i + g, 53).Value
End If
Next i
Next j
Sheets("Regressions").Activate
For i = g + 1 To ligne
For j = 1 To col
Cells(i, j).Value = data(i, j)
Next j
Next i
For i = g + 1 To ligne Step 3 '3 is the number of factors that we have + 1
Reg = WorksheetFunction.LinEst(Range(Cells(i, 1), Cells(i, 1).End(xlToRight)), Range(Cells(i + 1, 1), Cells(i + 2, 1).End(xlToRight)), , True)
Cells(i, 45) = Reg(1, 1) 'gets the gamma for beta
Cells(i, 46) = Reg(1, 2) 'gets the gamma for beta^2
Cells(i, 47) = Reg(3, 1) 'gets the r^2
Next i
Next g
End Sub |
Retraitement de données avec VBA codes
Répondre avec citation
Tutoriel : 
. Mon code est moins simple que le tiens. Mais bon, l'important c'est qu'il fonctionne.
Partager