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

Résolu/Fermé

Pir27 Messages postés 14 Date d'inscription samedi 13 avril 2013 Statut Membre Dernière intervention 9 mars 2015 - 3 oct. 2013 à 13:26
Pir27 Messages postés 14 Date d'inscription samedi 13 avril 2013 Statut Membre Dernière intervention 9 mars 2015 - 8 oct. 2013 à 09:29

Bonjour,

J'ai deux fichiers Excel, je veux modifier le tableau du fichier1 en fonction du tableau du fichier 2.

Le tableau du fichier1 a les colonnes "ID","Description","Détail" et "Date de création".
Je remplie les valeurs de la colonne "Détail" à la main à partir d'une autre application.
Les trois autres colonnes sont exportées automatiquement.

Le tableau du fichier2 a les colonnes "ID","Description" et "Date de création".

Je peux donc faire la comparaison en me basant sur la colonne ID.

Je souhaite que les lignes présentes dans le fichier1 et absentes dans le fichier2 soient supprimées du fichier 1.
Je souhaite aussi que les lignes présentes dans le fichier 2 et absentes dans le fichier 1 soient insérées dans le fichier 1.
Et bien sur que les lignes présentes dans les 2 fichiers ne bougent pas.

Je souhaite faire cette mise à jour afin de ne pas avoir à chercher une seconde fois les mêmes valeurs de la colonne "Détail" déjà reportées dans le fichier1.

Pouvez-vous me proposer une macro pouvant faire cette modification que j'ai à faire quotidiennement.

Merci beaucoup de votre aide.

A voir également:

Modification d'un tableau à partir de 2 fichiers Excel 2010
Tableau croisé dynamique - Guide
Liste déroulante excel - Guide
Tableau ascii - Guide
Wetransfer gratuit fichiers lourd - Guide
Aller à la ligne excel - Guide

15 réponses

Réponse 1 / 15

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
3 oct. 2013 à 16:36

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

Réponse 2 / 15

Pir27
7 oct. 2013 à 08:56

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.

Réponse 3 / 15

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié par f894009 le 7/10/2013 à 09:14

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+

Réponse 4 / 15

Pir27
7 oct. 2013 à 10:40

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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 15

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 7/10/2013 à 11:18

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

Réponse 6 / 15

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié par f894009 le 7/10/2013 à 11:26

Re,

fichier2 et 1:

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

Réponse 7 / 15

Pir27
7 oct. 2013 à 11:46

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 ??)

Réponse 8 / 15

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
7 oct. 2013 à 12:03

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

Réponse 9 / 15

Pir27
7 oct. 2013 à 13:31

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

Réponse 10 / 15

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
7 oct. 2013 à 14:36

Re,

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

Réponse 11 / 15

Pir27
7 oct. 2013 à 15:22

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.

Réponse 12 / 15

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
7 oct. 2013 à 15:41

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+

Réponse 13 / 15

Pir27
7 oct. 2013 à 16:13

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.

Réponse 14 / 15

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
7 oct. 2013 à 16:25

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+

Réponse 15 / 15

Pir27 Messages postés 14 Date d'inscription samedi 13 avril 2013 Statut Membre Dernière intervention 9 mars 2015
8 oct. 2013 à 09:29

Bonjour,

Ca fonctionne très bien.

1000 fois merci.

Discussions similaires

Chemin Logo du site de la Cité de l'espace

comment donner les droits sur fichier partage

programme qui n'affiche pas le mot secret

Discussions similaires

Newsletters