Erreur 424 Objet requis [Résolu/Fermé]

Signaler
-
Messages postés
14
Date d'inscription
samedi 13 avril 2013
Statut
Membre
Dernière intervention
9 mars 2015
-
Bonjour,

Lorsque j'utilise ma macro (qui met à jour un fichier à partir d'un autre fichier),
J'obtiens l'erreur 424 "Objet requis" sur la boucle pour ajout manquant correspndant à la ligne de code : For Each cel In Plage_ID2.

La macro est la suivante :

Sub traitement_enregistrements()
Dim derlig1 As Integer, derlig2 As Integer
Dim Dico1, Dico2, cel, Plage_ID2, Plage_ID1

Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")

'dico2 pour comparaison enregistrement(s) en trop(s) fichier1
With Worksheets("Export")
derlig2 = .Range("A" & Rows.Count).End(xlUp).Row
Set Plage_ID2 = .Range("A2:A" & derlig2)
For Each cel In Plage_ID2
If Not Dico2.Exists(cel.Value) Then
Dico2.Add cel.Value, cel.Value
End If
Next cel
End With

'ouverture fichier1.xls
Set fichier1 = Workbooks.Open("D:\Documents and Settings\t0030282\Bureau\Export_HPOV_à_jour.xlsx")

With Workbooks("Export_HPOV_à_jour.xlsx").Worksheets("Export")
lig = 2
Do While .Cells(lig, 1) <> ""
If Not Dico2.Exists(Cells(lig, 1).Value) Then
'suppression ligne
.Rows(lig).Delete
Else
lig = lig + 1
End If
Loop
'Dico pour ajout enregistrement manquant fichier1 dans fichier2
derlig1 = .Range("A" & Rows.Count).End(xlUp).Row
Set Plage_ID1 = .Range("A2:A" & derlig1)
For Each cel In Plage_ID1
If Not Dico1.Exists(cel.Value) Then
Dico1.Add cel.Value, cel.Value
End If
Next cel
'boucle pour ajout manquant
For Each cel In Plage_ID2
If Not Dico1.Exists(cel.Value) Then
derlig1 = derlig1 + 1
addr = cel.Row
.Range("A" & derlig1) = Workbooks("Export_HPOV_21-10-2013.xls").Worksheets("Export").Range("A" & addr)
.Range("C" & derlig1) = Workbooks("Export_HPOV_21-10-2013.xls").Worksheets("Export").Range("B" & addr)
.Range("E" & derlig1) = Workbooks("Export_HPOV_21-10-2013.xls").Worksheets("Export").Range("C" & addr)
.Range("F" & derlig1) = Workbooks("Export_HPOV_21-10-2013.xls").Worksheets("Export").Range("D" & addr)
.Range("G" & derlig1) = Workbooks("Export_HPOV_21-10-2013.xls").Worksheets("Export").Range("E" & addr)
End If
Next cel
End With
End Sub


D'avance merci de votre réponse.

4 réponses

Messages postés
15261
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 août 2020
1 319
Bonjour,

C'est le code que je vous ai fait debut octobre, le probleme est lie a des cellules vides. Il me semble que je vous ai donne un code avec des modif pour traiter ce probleme, modif suggerees par eriic ou michel_m de CCM.

A+
Messages postés
14
Date d'inscription
samedi 13 avril 2013
Statut
Membre
Dernière intervention
9 mars 2015

Bonjour, je ne comprend pas, la modif de Michel m est bien dans le code :
For Each cel In Plage_ID1
If Not Dico1.Exists(cel.Value) Then
Dico1.Add cel.Value, cel.Value
End If
Next cel

juste avant la 'Boucle pour ajout manquant'

Dois-je la répéter à l'intérieur de cette boucle ?

Merci.
Messages postés
15261
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 août 2020
1 319
Bonjour,

Autant pour moi, la modif oubliee a cet endroit (voir correction en gras).

Sub traitement_enregistrements()
Dim derlig1 As Integer, derlig2 As Integer
Dim Dico1, Dico2, cel, Plage_ID2, Plage_ID1

Application.ScreenUpdating = False

Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")

'dico2 pour comparaison enregistrement(s) en trop(s) fichier1
With Worksheets("feuil1")
derlig2 = .Range("A" & Rows.Count).End(xlUp).Row
Set Plage_ID2 = .Range("A2:A" & derlig2)
For Each cel In Plage_ID2
Dico2.Add cel.Value, cel.Value
Next cel
End With

'ouverture fichier1.xls
Set fichier1 = Workbooks.Open("D:\_Docs_Prog_Excel\_Excel_a_traiter\Dico\fichier1.xls")

With Workbooks("fichier1.xls").Worksheets("feuil1")
lig = 2
Do While .Cells(lig, 1) <> ""
If Not Dico2.exists(Cells(lig, 1).Value) Then
'suppression ligne
.Rows(lig).Delete
Else
lig = lig + 1
End If
Loop
'Dico pour ajout enregistrement manquant fichier1 dans fichier2
derlig1 = .Range("A" & Rows.Count).End(xlUp).Row
Set Plage_ID1 = .Range("A2:A" & derlig1)
For Each cel In Plage_ID1
If Not Dico1.exists(Cells(lig, 1).Value) Then
Dico1.Add cel.Value, cel.Value
End If
Next cel
'boucle pour ajout manquant
For Each cel In Plage_ID2
If Not Dico1.exists(cel.Value) Then
derlig1 = derlig1 + 1
addr = cel.Row
.Range("A" & derlig1) = Workbooks("fichier2.xls").Worksheets("feuil1").Range("A" & addr)
.Range("B" & derlig1) = Workbooks("fichier2.xls").Worksheets("feuil1").Range("B" & addr)
.Range("D" & derlig1) = Workbooks("fichier2.xls").Worksheets("feuil1").Range("C" & addr)
End If
Next cel
End With

Set Dico1 = Nothing
Set Dico2 = Nothing

Application.ScreenUpdating = True
End Sub
Messages postés
14
Date d'inscription
samedi 13 avril 2013
Statut
Membre
Dernière intervention
9 mars 2015

J'ai modifié ma macro mais j'ai désormais un problème plus général.

Lorsque je clique sur l'onglet affichage et que j'appuie sur l'icône pour ouvrir les macros, mon fichier excell se ferme.

Avez-vous une idée pour résoudre ce dysfonctionnement ??

Merci.
Messages postés
14
Date d'inscription
samedi 13 avril 2013
Statut
Membre
Dernière intervention
9 mars 2015

Désolé, erreur de ma part.

Ca marche.

Merci encore pour tout.

Je marque comme Résolu.