Modification d'un tableau à partir de 2 fichiers Excel 2010 [Résolu/Fermé]

Messages postés
14
Date d'inscription
samedi 13 avril 2013
Statut
Membre
Dernière intervention
9 mars 2015
- - Dernière réponse : 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.


Afficher la suite 

15 réponses

Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
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
0
Merci
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.
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
Bonjour,

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

fichier exemple:http://cjoint.com/?CJhjnMuNdaK


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

A+
0
Merci
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
Messages postés
15934
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 octobre 2019
2811
0
Merci
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
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
Re,

fichier2 et 1:

colonne A, avez-vous des cellules vides au debut ???
0
Merci
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 ??)
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
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
0
Merci
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
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
Re,

En mettant un espion, le Range est vide. lequel, il y a celui qui doit etre ecrit et celui qui est lu ????
0
Merci
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.
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
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+
0
Merci
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.
Messages postés
14791
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
16 octobre 2019
1177
0
Merci
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+
Messages postés
14
Date d'inscription
samedi 13 avril 2013
Statut
Membre
Dernière intervention
9 mars 2015
0
Merci
Bonjour,

Ca fonctionne très bien.

1000 fois merci.