Discussion :

[byran444]

Bonjour a tous;
J'ai cette erreur
Run-time error '1004'
Method 'Range' of object '_Global' failed


Avec le code suivant

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
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

Il surligne en jaune la ligne suivante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If WorksheetFunction.IsErr(WorksheetFunction.Match(SerieDate(i), Range("Quotation").Resize(, j * 2 + 1), 0)) = False Then

Voici le fichier
https://docs.google.com/open?id=0B1X...GJzNWFJYktRb0E

Merci beaucoup pour votre aide!!

[jfontaine]

Bonjour,

Cette erreur intervient quand WorksheetFunction retourne une erreur de calcul (#NA, #VALUE, etc ...)

Une parade avec Resume Next

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
On Error Resume Next
If WorksheetFunction.IsErr(WorksheetFunction.Match(SerieDate(i), Range("Quotation").Resize(, j * 2 + 1), 0)) = False Then
...
End If
 
On error Goto 0