Modification d'un tableau à partir de 2 fichiers Excel 2010

Bonjour,

une facon de faire

changez les noms de fichier et leur chemin, les letres colonnes et essayez

a vous d'ajouter les fermetures fichiers

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
            Dico1.Add cel.Value, cel.Value
        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

Bonjour,

Merci de votre réponse rapide.

Désolé, je n'y connais rien en VB.

Dois-je recopier la macro sur le fichier1 (celui à mettre à jour) ou le fichier 2.

Que signifie "Fermeture de fichier" ?

Merci encore.

Bonjour,

code a mettre dans un module du fichier2, inserez un bouton controle de formulaire et affectez la macro traitement_enregistrements

fichier exemple:https://www.cjoint.com/?CJhjnMuNdaK

Que signifie "Fermeture de fichier" ? ajouter le code pour fermer automatiquement le ou les fichiers ouverts

A+

Re-bonjour,

Lorsque j'exécute votre exemple, ou la macro que j'ai copié dans mon fichier, j'obtiens l'erreur suivante :

Erreur d'exécution '457'
Cette clé est déjà associée à un élément de cette collection

Et lorsque je débugue, cela s'arrète à la ligne Dico2.Add cel.Value, cel.Value
de la boucle 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

Pour info, je ne sais pas si j'ai tot bien adapté :

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("Export")
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:\Documents and Settings\t0030282\Bureau\Export_HPOV_à_jour_au_0210.xls")

With Workbooks("Export_HPOV_à_jour_au_0210.xls").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
Dico1.Add cel.Value, cel.Value
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_03-10-2013.xls").Worksheets("Export").Range("A" & addr)
.Range("B" & derlig1) = Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export").Range("B" & addr)
.Range("D" & derlig1) = Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export").Range("C" & addr)
End If
Next cel
End With

Set Dico1 = Nothing
Set Dico2 = Nothing

Application.ScreenUpdating = True
End Sub

Bonjour,

Cela vient du fait que tu as un ou des doublons dans ta liste. les doublons sont refusés dans le dictionary. il faut donc tester la non existence

For Each cel In Plage_ID2
If not dico2.Exists(cel.value) then
Dico2.Add cel.Value, cel.Value
End if
Next cel

m^me punition pour dico1

D'autre part, il serait peut ^tre intéressant d'indiquer le type des variables en ligne2 et on peut peut-^tre se dispenser d'une boucle à la restitution mais...
Les 2 set dico=nothing et application.screenupdating=true sont inutiles
Michel

Re,

fichier2 et 1:

colonne A, avez-vous des cellules vides au debut ???

Re,

J'ai supprimé les doublons de mes 2 listes et je n'ai pas de ligne vide.

Cette fois, j'ai l'erreur d'exécution 09 :
L'indice n'appartient pas à la sélection.

Débug, le première ligne de Range dans

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_03-10-2013.xls").Worksheets("Export").Range("A" & addr)
.Range("B" & derlig1) = Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export").Range("B" & addr)
.Range("D" & derlig1) = Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export").Range("C" & addr)
End If
Next cel
End With

Le workbooks correspond au fichier exécutant la macro (besoin de le déclarer, rajouter le chemin ??)

Re,

Le workbooks correspond au fichier exécutant la macro (besoin de le déclarer, rajouter le chemin ??) ???????

Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export")

l'onglet Export existe ??

quand vous avez l'erreur, click sur debugage, passez le curseur souris sur les objets de la ligne en erreur pour voir leur contenu

Re,

L'onglet Export existe, je ne vois pas les valeurs des objets (Faut-il utiliser un espion ?)
En mettant un espion, le Range est vide.

Dans l'explorateur de projet/Microsoft Excel Objets j'ai deux objets :
Feuil1 (Export)
ThisWorkbook

Re,

En mettant un espion, le Range est vide. lequel, il y a celui qui doit etre ecrit et celui qui est lu ????

Re,

En lancant la macro pas à pas, je bloque ici :

'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_03-10-2013.xls").Worksheets("Export").Range("A" & addr)
.Range("B" & derlig1) = Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export").Range("B" & addr)
.Range("D" & derlig1) = Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export").Range("C" & addr)
End If

A la ligne For Each cel In Plage_ID2 cel est vide et plage_ID2 est vide (espion).
J'ai une erreur d'exécution '424' : Objet requis.
Faut-il redéfinir les variables cel ou plage_ID2 ?

Pour les range, je parlais des range précédent mais j'ai du me tromper car tout fonctione jusqu'ici.

Re,

ai ajoute la modif michel_m, pour moi ca marche, mais je n'ai pas vos donnees

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_au_0210.xls")

    With Workbooks("Export_HPOV_à_jour_au_0210.xls").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_03-10-2013.xls").Worksheets("Export").Range("A" & addr)
                .Range("B" & derlig1) = Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export").Range("B" & addr)
                .Range("D" & derlig1) = Workbooks("Export_HPOV_03-10-2013.xls").Worksheets("Export").Range("C" & addr)
            End If
        Next cel
    End With
End Sub

A+

Re,

Cela semble fonctionner.
Par contre, avant de marquer comme résolu, est-ce dans le fichier1 ou le fichier2 que se font les ajouts et suppressions de ligne. Je pensen qu'il y a eu une inversion par rapport à ma demande initiale Ce qui n'est pas nécessairement un problème (juste les noms de fichiers à inverser).

Merci encore.

Re,

est-ce dans le fichier1 ou le fichier2 que se font les ajouts et suppressions de ligne. dans votre demande: suppression des lignes fichier1 non presentes dans fichier2 et et ajout lignes fichier1 manquantes dans fichier2. Le code fourni fait ce que vous avez demande.

A+

Bonjour,

Ca fonctionne très bien.

1000 fois merci.