Erreur 424 Objet requis

Résolu
Pir27 -  
Pir27 Messages postés 14 Date d'inscription   Statut Membre Dernière intervention   -
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

Réponse 1 / 4
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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+
0
Réponse 2 / 4
Pir27 Messages postés 14 Date d'inscription   Statut Membre Dernière intervention  
 
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.
0
Réponse 3 / 4
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
0
Réponse 4 / 4
Pir27 Messages postés 14 Date d'inscription   Statut Membre Dernière intervention  
 
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.
0
Pir27 Messages postés 14 Date d'inscription   Statut Membre Dernière intervention  
 
Désolé, erreur de ma part.

Ca marche.

Merci encore pour tout.

Je marque comme Résolu.
0

Discussions similaires

Problème d'app Gmail : "Identifiants requis"
Tekaro -
GaLlIoNGP69 -

4 réponses
Erreur 3005 sur France TV
Cambodgil -
PK -

5 réponses
Identifiant requis
Nimeria -
nadellen -

1 réponse
Identifiants corrects requis
Kyestha -
markess034 -

2 réponses
Code erreur 3000
Laurent -
JM -

5 réponses