Erreur 424 Objet requis Résolu/Fermé

Question

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	0030282\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.

f894009 · Answer

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+

Pir27 · Answer

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.

f894009 · Answer

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 = TrueEnd Sub

Pir27 · Answer

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.

Erreur 424 Objet requis

4 réponses

Discussions similaires