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 |