Comparaison de 2 tableaux avec modifications
Résolu
Kuartz
Messages postés
852
Date d'inscription
Statut
Membre
Dernière intervention
-
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour à tous.
On m'a aidé sur ce forum à créer un code qui compare 2 tableaux et fait des actions en fonction de ces comparaisons.
Voici le code :
Voici le lien pour télécharger mon fichier anonymé :
https://www.cjoint.com/c/EFEjnUOyZ2f
Plus d'explications (même si le code parle de lui même) :
Le code est censé comparer les colonnes C, E et J de 2 tableaux en feuille 1 et en feuille 2 et en fonction de ces comparaisons, faire des actions.
- Si une ligne se trouve dans le tableau n°1 (feuille 1) et pas dans le tableau n°2 (feuille 2), alors, il faut ajouter la ligne au tableau 2.
- Si une ligne se trouve dans le tableau n°2 (feuille 2) et pas dans le tableau n°1 (feuille 1), alors, il faut supprimer la ligne du tableau 2.
- Si les lignes sont les mêmes, aucune action.
J'ai ensuite ajouté un code à ma sauce pour exécuter un tri (car les lignes ajoutées étaient ajoutées tout en bas du tableau, alors que je souhaite avoir les éléments dans le même ordre, question pratique).
Mes problèmes sur les tests réalisés :
1°/ : Si je vide le tableau de la feuille 2 et que j'exécute la macro avec le bouton "UPDATE", le tableau de la feuille 2 se remplit avec les éléments de la feuille 1 (jusque-là normal) sauf 2 lignes qui n'apparaîtront que si l'on relance encore une fois la macro. Ce n'est pas normal.
2°/ : Si je supprime volontairement une ligne du tableau 1 (feuille 1) et que je relance la macro, la ligne ne se supprime pas dans le tableau 2 (feuille 2).
Merci d'avance de vous pencher sur mon problème. Je sais qu'il est un peu complexe.
Bien cordialement.
On m'a aidé sur ce forum à créer un code qui compare 2 tableaux et fait des actions en fonction de ces comparaisons.
Voici le code :
Sub COMPARATIF() Dim O1 As Worksheet 'déclare la variable O1 (Onglet 1) Dim O2 As Worksheet 'déclare la variable O2 (Onglet 2) Dim TC1 As Variant 'déclare la variable TC1 (Tableau de Cellules 1) Dim TC2 As Variant 'déclare la variable TC2 (Tableau de Cellules 2) Dim I As Long 'déclare la variable I (Incrément) Dim J As Long 'déclare la variable J (incrément) Dim TEST As Boolean 'déclare la variable TEST Dim DEST As Range 'déclare la variable DEST (cellule de DESTination) Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes) Dim T1 As String 'déclare la variable T1 (Texte 1) Dim T2 As String 'déclare la variable T2 (Texte 2) Dim K As Long 'déclare la variable K (incrément) '********************************************************************************* 'copie les lignes du tableau 1 dans le tableau 2 (si manquantes dans le tableau 2) '********************************************************************************* Set O1 = Sheets(1) 'définit l'onglet O1 (à adapter) Set O2 = Sheets(2) 'définit l'onglet O2 (à adapter) TC1 = O1.Range("A3:J" & O1.Cells(Application.Rows.Count, 1).End(xlUp).Row) 'définit le tableau de cellules TC1 (à adapter, j'ai pris la colonne 1 comme référence pour la derniere ligne) TC2 = O2.Range("A4:J" & O2.Cells(Application.Rows.Count, 1).End(xlUp).Row) 'définit le tableau de cellules TC2 (à adapter, j'ai pris la colonne 1 comme référence pour la derniere ligne) For I = 1 To UBound(TC1, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellules TC1 TEST = False 'définit la variable TEST T1 = CStr(TC1(I, 3)) & "/" & CStr(TC1(I, 5)) & "/" & CStr(TC1(I, 10)) 'définit le texte T1 (concatenation des cellules colonnes 3, 5 et 10 = C, E et J) For J = 1 To UBound(TC2, 1) 'boucle 2 : pour toutes les lignes J du tableau de cellules TC2 T2 = CStr(TC2(J, 3)) & "/" & CStr(TC2(J, 5)) & "/" & CStr(TC2(J, 10)) 'définit le texte T2 (concaténation des cellules colonnes 3, 5 et 10 = C, E et J) If T1 = T2 Then TEST = True: Exit For 'si T1 est égal à T2, TEST devient [Vrai], sort de la boucle 2 Next J 'prochaine ligne de la boucle 2 If TEST = False Then 'condition : si TEST est [FAUX] Set DEST = O2.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination (première ligne vide du tableau TC2) DEST.Resize(1, UBound(TC1, 2)) = Application.Index(TC1, I) 'récupère la ligne du tabelau TC1 dans DEST End If 'fin de la condition Next I 'prochaine ligne de la boucle 1 '**************************************************************** 'efface les lignes du tableau 2 (si manquantes dans le tableau 1) '**************************************************************** For I = 1 To UBound(TC2, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellules TC2 TEST = False 'définit la variable TEST T2 = CStr(TC2(I, 3)) & "/" & CStr(TC2(I, 5)) & "/" & CStr(TC2(I, 10)) 'définit le texte T2 (concaténation des cellules colonnes 3, 5 et 10 = C, E et J) For J = 1 To UBound(TC1, 1) 'boucle 2 : sour toutes les lignes J du tableau de cellules TC1 T1 = CStr(TC1(J, 3)) & "/" & CStr(TC1(J, 5)) & "/" & CStr(TC1(J, 10)) 'définit le texte T1 (concatenation des cellules colonnes 3, 5 et 10 = C, E et J) If T2 = T1 Then TEST = True: Exit For 'si T2 est égal à T1, TEST devient [Vrai], sort de la boucle 2 Next J 'prochaine ligne de la boucle 2 If TEST = False Then 'condition : si TEST est [FAUX] ReDim Preserve TL(K) 'redimensionne le tableau TL TL(K) = I + 4 'récupère dans TL(K) le numéro de la ligne K = K + 1 'incrémente K End If 'fin de la condition Next I 'prochaine ligne de la boucle 1 If K > 0 Then 'condition : si K est supérieur à zéro For I = UBound(TL) To LBound(TL) Step -1 'boucle inversé de la dernière valeur du tableau TL à la première O2.Rows(TL(I)).Delete 'efface la ligne TL(I) Next I 'prochaine valeur de la boucle End If 'fin de la condition
Voici le lien pour télécharger mon fichier anonymé :
https://www.cjoint.com/c/EFEjnUOyZ2f
Plus d'explications (même si le code parle de lui même) :
Le code est censé comparer les colonnes C, E et J de 2 tableaux en feuille 1 et en feuille 2 et en fonction de ces comparaisons, faire des actions.
- Si une ligne se trouve dans le tableau n°1 (feuille 1) et pas dans le tableau n°2 (feuille 2), alors, il faut ajouter la ligne au tableau 2.
- Si une ligne se trouve dans le tableau n°2 (feuille 2) et pas dans le tableau n°1 (feuille 1), alors, il faut supprimer la ligne du tableau 2.
- Si les lignes sont les mêmes, aucune action.
J'ai ensuite ajouté un code à ma sauce pour exécuter un tri (car les lignes ajoutées étaient ajoutées tout en bas du tableau, alors que je souhaite avoir les éléments dans le même ordre, question pratique).
Mes problèmes sur les tests réalisés :
1°/ : Si je vide le tableau de la feuille 2 et que j'exécute la macro avec le bouton "UPDATE", le tableau de la feuille 2 se remplit avec les éléments de la feuille 1 (jusque-là normal) sauf 2 lignes qui n'apparaîtront que si l'on relance encore une fois la macro. Ce n'est pas normal.
2°/ : Si je supprime volontairement une ligne du tableau 1 (feuille 1) et que je relance la macro, la ligne ne se supprime pas dans le tableau 2 (feuille 2).
Merci d'avance de vous pencher sur mon problème. Je sais qu'il est un peu complexe.
Bien cordialement.
A voir également:
- Comparaison de 2 tableaux avec modifications
- Suivi des modifications word - Guide
- Supercopier 2 - Télécharger - Gestion de fichiers
- Fusionner 2 tableaux excel - Guide
- Whatsapp avec 2 sim - Guide
- 2 ecran pc - Guide
8 réponses
Bonjour
Ci dessous une proposition de code pas encore testée
Pour m'aider:
Pour que je puisse tester + facilement, pourais tu me dire les numéros de ligne des "nouveaux tiers" et dles "relances effectuées"
D'avance Merci
Michel
Ci dessous une proposition de code pas encore testée
Option Explicit
'------------------------------------------------------------------------
Sub mettre_a_jour()
Dim Derlig As Integer, T_tiers, Cptr As Integer, D_tiers As Object, Concat As String, _
T_keys_tiers, T_ligne_t
Dim T_relance, D_relance As Object, T_keys_rel, T_ligne_r
Dim Copie
'--------------------------------initialisations
Application.ScreenUpdating = False
'mémorisation des "tiers"
With Sheets("Grand-livre des tiers")
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_tiers = .Range("A3:J" & Derlig)
Set D_tiers = CreateObject("scripting.dictionary")
For Cptr = 1 To UBound(T_tiers)
Concat = T_tiers(Cptr, 3) & " " & T_tiers(Cptr, 5) & " " & T_tiers(Cptr, 10)
'création d'un dictionnaire clé : "éléments à comparer item=ligne classeur
If Not D_tiers.exists(Concat) Then D_tiers.Add Concat, Cptr + 2
Next
End With
'mémorisation des "relances"
T_keys_tiers = D_tiers.keys
T_ligne_t = D_tiers.items
With Sheets("Tableau de relance")
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_relance = .Range("A4:J" & Derlig)
Set D_tiers = CreateObject("scripting.dictionary")
For Cptr = 1 To UBound(T_relance)
Concat = T_relance(Cptr, 3) & " " & T_relance(Cptr, 5) & " " & T_relance(Cptr, 10)
'création d'un dictionnaire clé : "éléments à comparer, ligne classeur
If Not D_relance.exists(Concat) Then D_relance.Add Concat, Cptr + 3
Next
T_keys_rel = D_relance.keys
T_ligne_r = D_relance.items
End With
'-----------------------------------------------Mises à jour
' nouveaux tiers: ajoute une ligne aux relances
For Cptr = 0 To D_tiers.Count - 1
If Not D_relance.exists(T_keys_tiers(Cptr)) Then
Copie = Sheets("Grand-livre des tiers").Range(Cells(T_ligne_t(Cptr), "A"), Cells(T_ligne_t(Cptr), "J"))
Derlig = Derlig + 1
Sheets("Tableau de relance").Range(Cells(Derlig, "A"), Cells(Derlig, "J")) = Copie
End If
Next
'relance effectuée
For Cptr = 0 To D_relance.Count - 1
If Not D_tiers.exists(T_keys_rel(Cptr)) Then
Sheets("Tableau de relance").Rows(T_ligne_r(Cptr)).Delete
End If
Next
MsgBox "Mises à jour effectuées"
End Sub
Pour m'aider:
Pour que je puisse tester + facilement, pourais tu me dire les numéros de ligne des "nouveaux tiers" et dles "relances effectuées"
D'avance Merci
Michel
Kuartz
Messages postés
852
Date d'inscription
Statut
Membre
Dernière intervention
61
J'ai Variable Objet non défini lorsque j'exécute la macro sur la ligne "If Not D_relance.exists(Concat) Then" il semble que ton code soit beaucoup plus fiable que celui que j'avais précédemment...
Bonjour,
michel_m: les dico sont vraiment au poil pour ce genre de "tri"
neanmoins, fichier de Kuartz corrige : https://www.cjoint.com/c/EFEnln6RnNf
1: du au tableau "vide", ajoute un test
2: un l+4 au lieu de l+3
michel_m: les dico sont vraiment au poil pour ce genre de "tri"
neanmoins, fichier de Kuartz corrige : https://www.cjoint.com/c/EFEnln6RnNf
1: du au tableau "vide", ajoute un test
2: un l+4 au lieu de l+3
Tout d'abord, merci beaucoup pour l'aide.
Je viens de tester, j'ai "Erreur de compilation, variable non définie" et en surligné D_Relance.
Après ne te prend pas la tête, ajoute une ligne au hasard sur le tableau 1. Et je te propose d'écrire une date dans "DATE LETTRE RAPPEL 1". Normalement, il faudrait que le code se comporte de façon à supprimer les lignes qui ne sont pas dans le tableau 1 et à rajouter les lignes en 1 et pas en 2, tout en gardant la date en face de la bonne ligne, comme auparavant dans DATE LETTRE RAPPEL 1.
Je viens de tester, j'ai "Erreur de compilation, variable non définie" et en surligné D_Relance.
Après ne te prend pas la tête, ajoute une ligne au hasard sur le tableau 1. Et je te propose d'écrire une date dans "DATE LETTRE RAPPEL 1". Normalement, il faudrait que le code se comporte de façon à supprimer les lignes qui ne sont pas dans le tableau 1 et à rajouter les lignes en 1 et pas en 2, tout en gardant la date en face de la bonne ligne, comme auparavant dans DATE LETTRE RAPPEL 1.
Pour l'instant les tableaux sont identiques, il suffit de les modifier au hasard pour voir le comportement du code.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
O2.Range("A4:J70").ClearContents : Pourquoi cette ligne ajoutée?
Le but n'est pas d'avoir un tableau vide en feuille 2.
Je m'explique, le tableau 1 va changer chaque mois, il s'agit de données en comptabilité. Le tableau 2 doit s'adapter en fonction du tableau 1. Mais des choses vont être ajoutées au tableau 2 dans "LETTRE DE RAPPEL 1" etc. Et ces choses là doivent absolument rester en face de la ligne correspondante.
Le tableau 2 ne doit jamais être supprimé en fait.
Le but n'est pas d'avoir un tableau vide en feuille 2.
Je m'explique, le tableau 1 va changer chaque mois, il s'agit de données en comptabilité. Le tableau 2 doit s'adapter en fonction du tableau 1. Mais des choses vont être ajoutées au tableau 2 dans "LETTRE DE RAPPEL 1" etc. Et ces choses là doivent absolument rester en face de la ligne correspondante.
Le tableau 2 ne doit jamais être supprimé en fait.
ci joint code testé avec succès
peut-^tre jeter un oeil avant de marquer résolu ne serait ce que par politesse envers quelqu'un qui s'est cassé le... pour te montrer l'utilité d'un objet dictionary pour ce genre de problème
http://www.cjoint.com/c/EFEp7qlLsZr
je le mets quand m^me sans me faire trop d'illusions
peut-^tre jeter un oeil avant de marquer résolu ne serait ce que par politesse envers quelqu'un qui s'est cassé le... pour te montrer l'utilité d'un objet dictionary pour ce genre de problème
http://www.cjoint.com/c/EFEp7qlLsZr
je le mets quand m^me sans me faire trop d'illusions
Bonjour,
j'ai fait la meme modif (principe) que dans le fichier de Kuartz, je mets le code car probleme avec ci-joint (!!!). Modif au plus simple car pas facile avec les tests dico
Si tableau Tableau de relance vide, la ca coince et la ligne 4 fraichement ecrite se trouve delete car dans le dico D_relance il y a les cellules de la ligne 3
With Sheets("Tableau de relance")
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_relance = .Range("A4:J" & Derlig)
et ici sans le test si non vide
For Cptr = 0 To D_relance.Count - 1
If memligdep > 3 And Not D_tiers.exists(T_keys_rel(Cptr)) Then
ca efface la ligne
j'ai fait la meme modif (principe) que dans le fichier de Kuartz, je mets le code car probleme avec ci-joint (!!!). Modif au plus simple car pas facile avec les tests dico
Option Explicit '------------------------------------------------------------------------ Sub mettre_a_jour() Dim Derlig As Integer, T_tiers, Cptr As Integer, D_tiers As Object, Concat As String, _ T_keys_tiers, T_ligne_t Dim T_relance, D_relance As Object, T_keys_rel, T_ligne_r Dim Copie Dim memligdep '--------------------------------initialisations Application.ScreenUpdating = False 'Sheets("Tableau de relance").Range("A4:J70").ClearContents 'mémorisation des "tiers" With Sheets("Grand-livre des tiers") Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row T_tiers = .Range("A3:J" & Derlig) Set D_tiers = CreateObject("scripting.dictionary") For Cptr = 1 To UBound(T_tiers) Concat = T_tiers(Cptr, 3) & " " & T_tiers(Cptr, 5) & " " & T_tiers(Cptr, 10) 'création d'un dictionnaire clé : "éléments à comparer item=ligne classeur If Not D_tiers.exists(Concat) Then D_tiers.Add Concat, Cptr + 2 End If Next End With 'mémorisation des "relances" T_keys_tiers = D_tiers.keys T_ligne_t = D_tiers.items With Sheets("Tableau de relance") Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row T_relance = .Range("A4:J" & Derlig) Set D_relance = CreateObject("scripting.dictionary") For Cptr = 1 To UBound(T_relance) Concat = T_relance(Cptr, 3) & " " & T_relance(Cptr, 5) & " " & T_relance(Cptr, 10) 'création d'un dictionnaire clé : "éléments à comparer, ligne classeur If Not D_relance.exists(Concat) Then D_relance.Add Concat, Cptr + 3 End If Next T_keys_rel = D_relance.keys T_ligne_r = D_relance.items End With 'mise en memoire ligne pour savoir si tableau vide (=3) memligdep = Derlig '-----------------------------------------------Mises à jour ' nouveaux tiers: ajoute une ligne aux relances For Cptr = 0 To D_tiers.Count - 1 If memligdep <= 3 Or Not D_relance.exists(T_keys_tiers(Cptr)) Then With Sheets(1) Copie = .Range(.Cells(T_ligne_t(Cptr), 1), .Cells(T_ligne_t(Cptr), 10)) End With With Sheets(2) Derlig = Derlig + 1 .Range(.Cells(Derlig, 1), .Cells(Derlig, 10)) = Copie End With End If Next 'relance effectuée For Cptr = 0 To D_relance.Count - 1 If memligdep > 3 And Not D_tiers.exists(T_keys_rel(Cptr)) Then Sheets("Tableau de relance").Rows(T_ligne_r(Cptr)).Delete End If Next Set D_relance = Nothing Set D_tiers = Nothing Application.ScreenUpdating = True MsgBox "Mises à jour effectuées" End Sub</code>
Si tableau Tableau de relance vide, la ca coince et la ligne 4 fraichement ecrite se trouve delete car dans le dico D_relance il y a les cellules de la ligne 3
With Sheets("Tableau de relance")
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_relance = .Range("A4:J" & Derlig)
et ici sans le test si non vide
For Cptr = 0 To D_relance.Count - 1
If memligdep > 3 And Not D_tiers.exists(T_keys_rel(Cptr)) Then
ca efface la ligne
Bonjour,
Je ne connais pas du tout le principe d'un "dictionnary". Je vais tenter de déchiffrer le code.
Pour information, mon problème étant résolu et le code marchant parfaitement, j'ai mis le sujet en résolu. Je te prie de m'excuser si j'ai pu te froisser.
Je te remercie vraiment beaucoup d'avoir passé du temps sur mon problème et d'avoir même sorti un code à ta sauce pour m'arranger. Je vais me pencher dessus pour essayer de le comprendre (je n'ai que des bases de VBA). En tout cas, après l'avoir testé également, il marche absolument parfaitement.
Merci encore.
Je ne connais pas du tout le principe d'un "dictionnary". Je vais tenter de déchiffrer le code.
Pour information, mon problème étant résolu et le code marchant parfaitement, j'ai mis le sujet en résolu. Je te prie de m'excuser si j'ai pu te froisser.
Je te remercie vraiment beaucoup d'avoir passé du temps sur mon problème et d'avoir même sorti un code à ta sauce pour m'arranger. Je vais me pencher dessus pour essayer de le comprendre (je n'ai que des bases de VBA). En tout cas, après l'avoir testé également, il marche absolument parfaitement.
Merci encore.