Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all articles
Browse latest Browse all 21919

Run-time error '1004'

$
0
0
Hello everyone,

I have this error
Run-time error '1004'
Method 'Range' of object '_Global' failed


with the following code
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.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

It yellow at this line
Code:

If WorksheetFunction.IsErr(WorksheetFunction.Match(SerieDate(i), Range("Quotation").Resize(, j * 2 + 1), 0)) = False Then
Here is the filehttps://docs.google.com/open?id=0B1X...GJzNWFJYktRb0E

Thanks a lot for your help!!

Viewing all articles
Browse latest Browse all 21919

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>