Boumekhila
XLDnaute Nouveau
Bonjours tout le monde
j'ai une macro qui me donne erreure d'execution 13, si quel qu'un peut m'aidez, merci par avance
Option Explicit
Dim ListHisto, ListModif
Sub EcritLigne(Feuille As String, NumLigne As Long, Statut As String)
Dim Lig As Long
Lig = Sheets("comparison").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(Feuille).Range("A" & NumLigne & "E" & NumLigne).Copy Sheets("comparison").Range("A" & Lig)
Sheets("comparison").Range("E" & Lig).Value = Statut
End Sub
Sub ComparAlarm()
Dim CodesHisto(), CodesModif()
Dim i As Long, j As Long
Application.ScreenUpdating = False
'Lecture valeurs historique
ListHisto = Sheets("Ancien").Range("A1").CurrentRegion.Value And Sheets("Ancien").Range("D1").CurrentRegion.Value
'Lecture valeurs modifs
ListModif = Sheets("Nouveau").Range("A1").CurrentRegion.Value And Sheets("Nouveau").Range("D1").CurrentRegion.Value
'On efface les résultats
Sheets("comparison").Range("A2:E" & Rows.Count).ClearContents
ReDim CodesHisto(2 To UBound(ListHisto, 1))
ReDim CodesModif(2 To UBound(ListModif, 1))
'Code uniques colonnes A et b
For i = 2 To UBound(ListHisto, 1)
CodesHisto(i) = ListHisto(i, 1) & "$" & ListHisto(i, 2)
Next i
For i = 2 To UBound(ListModif, 1)
CodesModif(i) = ListModif(i, 1) & "$" & ListModif(i, 2)
Next i
'Parcours des historiques
For i = 2 To UBound(ListHisto, 1)
If IsError(Application.Match(CodesHisto(i), CodesModif, 0)) Then
Call EcritLigne("Nouveau", i, "Effacé")
Else
j = Application.Match(CodesHisto(i), CodesModif, 0) + 1
If ListHisto(i, 3) <> ListModif(j, 3) Or ListHisto(i, 4) <> ListModif(j, 4) Or ListHisto(i, 5) <> ListModif(j, 5) Then
Call EcritLigne("Nouveau", i, "Modifié")
End If
End If
Next i
'Parcours des modifs
For i = 2 To UBound(ListModif, 1)
If IsError(Application.Match(CodesModif(i), CodesHisto, 0)) Then
Call EcritLigne("Nouveau", i, "Nouveau")
End If
Next i
Application.ScreenUpdating = True
End Sub
j'ai une macro qui me donne erreure d'execution 13, si quel qu'un peut m'aidez, merci par avance
Option Explicit
Dim ListHisto, ListModif
Sub EcritLigne(Feuille As String, NumLigne As Long, Statut As String)
Dim Lig As Long
Lig = Sheets("comparison").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(Feuille).Range("A" & NumLigne & "E" & NumLigne).Copy Sheets("comparison").Range("A" & Lig)
Sheets("comparison").Range("E" & Lig).Value = Statut
End Sub
Sub ComparAlarm()
Dim CodesHisto(), CodesModif()
Dim i As Long, j As Long
Application.ScreenUpdating = False
'Lecture valeurs historique
ListHisto = Sheets("Ancien").Range("A1").CurrentRegion.Value And Sheets("Ancien").Range("D1").CurrentRegion.Value
'Lecture valeurs modifs
ListModif = Sheets("Nouveau").Range("A1").CurrentRegion.Value And Sheets("Nouveau").Range("D1").CurrentRegion.Value
'On efface les résultats
Sheets("comparison").Range("A2:E" & Rows.Count).ClearContents
ReDim CodesHisto(2 To UBound(ListHisto, 1))
ReDim CodesModif(2 To UBound(ListModif, 1))
'Code uniques colonnes A et b
For i = 2 To UBound(ListHisto, 1)
CodesHisto(i) = ListHisto(i, 1) & "$" & ListHisto(i, 2)
Next i
For i = 2 To UBound(ListModif, 1)
CodesModif(i) = ListModif(i, 1) & "$" & ListModif(i, 2)
Next i
'Parcours des historiques
For i = 2 To UBound(ListHisto, 1)
If IsError(Application.Match(CodesHisto(i), CodesModif, 0)) Then
Call EcritLigne("Nouveau", i, "Effacé")
Else
j = Application.Match(CodesHisto(i), CodesModif, 0) + 1
If ListHisto(i, 3) <> ListModif(j, 3) Or ListHisto(i, 4) <> ListModif(j, 4) Or ListHisto(i, 5) <> ListModif(j, 5) Then
Call EcritLigne("Nouveau", i, "Modifié")
End If
End If
Next i
'Parcours des modifs
For i = 2 To UBound(ListModif, 1)
If IsError(Application.Match(CodesModif(i), CodesHisto, 0)) Then
Call EcritLigne("Nouveau", i, "Nouveau")
End If
Next i
Application.ScreenUpdating = True
End Sub