ray444
12-10-2012, 03:18 AM
Hello I have an error with my macro
Here is the code
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.IsError(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
The error is in this line don't know why...
If WorksheetFunction.IsError(WorksheetFunction.Match(SerieDate(i), Range("Quotation").Resize(, j * 2 + 1), 0)) = False Then
In case you want to see the file https://docs.google.com/open?id=0B1XYA-Rihjk3OGJzNWFJYktRb0E
Thanks a lot in advance
R
Here is the code
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.IsError(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
The error is in this line don't know why...
If WorksheetFunction.IsError(WorksheetFunction.Match(SerieDate(i), Range("Quotation").Resize(, j * 2 + 1), 0)) = False Then
In case you want to see the file https://docs.google.com/open?id=0B1XYA-Rihjk3OGJzNWFJYktRb0E
Thanks a lot in advance
R