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
| Sub copydatabis()
Dim Nom As Variant
Dim NomStk(), SerieDate()
'Suppression des noms des plages
For Each Nom In ActiveWorkbook.Names
If Nom.Name = "Stocks" Or Nom.Name = "DateDeb" Or Nom.Name = "DateFin" Then
Nom.Delete
End If
Next
'Réinitialisation des plages Nom
ActiveWorkbook.Names.Add Name:="Stocks", RefersToR1C1:="=offset('Sheet1'!R4C1,1,,counta('Sheet1'!C1)-3,1)"
ActiveWorkbook.Names.Add Name:="DateDeb", RefersToR1C1:="=R1C2"
ActiveWorkbook.Names.Add Name:="DateFin", RefersToR1C1:="=R2C2"
NbDate = Range("DateFin").Value - Range("DateDeb").Value + 1
NbStocks = Range("Stocks").Rows.Count
ActiveWorkbook.Names.Add Name:="Quotation", RefersToR1C1:="=offset('Sheet1'!R4C3,,,NbDate,NbStocks*2)"
'Initialisation de la variable tableau NomStk
Cmpt = 0
For Each cell In Range("Stocks").Cells
ReDim Preserve NomStk(Cmpt)
NomStk(Cmpt) = cell.Value
Cmpt = Cmpt + 1
Next cell
'Initialisation de la variable tableau NomRef
Cmpt = 0
ReDim NomRef(UBound(NomStk, 1))
For i = 0 To UBound(NomStk, 1)
NomRef(i) = Range("Stocks").Cells(i + 1).Offset(0, 1).Value
Next i
'Initialisation de la série des dates jours ouvrés
Cmpt = 0
For i = Range("DateDeb").Value To Range("DateFin").Value
If WorksheetFunction.Weekday(CDate(i) < 7) Or WorksheetFunction.Weekday(CDate(i) > 1) Then
ReDim Preserve SerieDate(Cmpt)
SerieDate(Cmpt) = CDate(i)
Cmpt = Cmpt + 1
End If
Next i
'Compte le nombre de valeur <> "" dans le vecteur NomRef
Cmpt = 0
For i = 0 To UBound(NomRef)
If NomRef(i) <> "" Then Cmpt = Cmpt + 1
Next i
'Initialisation de la table des résultats
ReDim Returns(UBound(SerieDate), UBound(NomStk) - Cmpt)
'Resultats
For i = 0 To UBound(SerieDate)
For j = 0 To UBound(NomStk)
Cmpt = 0
For k = 0 To UBound(NomRef)
If NomStk(j) = NomRef(k) Then Cmpt = Cmpt + 1
Next k
If NomRef(j) = "" And Cmpt = 0 Then
If WorksheetFunction.IsErr(WorksheetFunction.Match(SerieDate(i), Range("Quotation").Resize(, j * 2 + 1), 0)) = False Then
LigStk = WorksheetFunction.Match(SerieDate(i), WorksheetFunction.Index(Range("Quotation"), 0, j * 2 + 1), 0)
Returns(i, j) = WorksheetFunction.Index(Range("Quotation"), LigStk, j * 2 + 2)
Else
Returns(i, j) = 0
End If
Else
DateLunch = WorksheetFunction.Index(Range("Quotation"), 1, j * 2 + 1)
RetStk = WorksheetFunction.Index(Range("Quotation"), 1, j * 2 + 2)
For k = 0 To UBound(NomStk)
If NomRef(j) = NomStk(k) Then ColRef = k
Next k
LigRef = WorksheetFunction.Match(DateLunch, WorksheetFunction.Index(Range("Quotation"), 0, ColRef * 2 + 1), 0)
RetRef = WorksheetFunction.Index(Range("Quotation"), LigRef, ColRef * 2 + 2)
LigRef = WorksheetFunction.Match(SerieDate(i), WorksheetFunction.Index(Range("Quotation"), 0, ColRef * 2 + 1), 0)
Returns(i, j) = RetSk / RetRef * WorksheetFunction.Index(Range("Quotation"), LigRef, ColRef)
End If
Next j
Next i
End Sub |
