Comparaison de 2 tableaux avec modifications
Résolu/Fermé
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
-
Modifié par Kuartz le 30/06/2015 à 11:25
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 1 juil. 2015 à 10:53
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 1 juil. 2015 à 10:53
A voir également:
- Comparaison de 2 tableaux avec modifications
- Suivi des modifications word - Guide
- Fusionner 2 tableaux excel - Guide
- Tableaux croisés dynamiques - Guide
- Word numéro de page 1/2 - Guide
- Whatsapp avec 2 cartes sim - Guide
8 réponses
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 310
Modifié par michel_m le 30/06/2015 à 15:17
Modifié par michel_m le 30/06/2015 à 15:17
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
f894009
Messages postés
17206
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 novembre 2024
1 709
Modifié par f894009 le 30/06/2015 à 15:16
Modifié par f894009 le 30/06/2015 à 15:16
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
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 310
30 juin 2015 à 15:20
30 juin 2015 à 15:20
bojour
Je viens de corriger le code avec pas mal de fautes de syntaxe
Je viens de corriger le code avec pas mal de fautes de syntaxe
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
61
Modifié par Kuartz le 30/06/2015 à 15:25
Modifié par Kuartz le 30/06/2015 à 15:25
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.
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
61
30 juin 2015 à 15:25
30 juin 2015 à 15:25
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
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
61
30 juin 2015 à 15:59
30 juin 2015 à 15:59
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.
f894009
Messages postés
17206
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 novembre 2024
1 709
30 juin 2015 à 16:05
30 juin 2015 à 16:05
Re,
Le but n'est pas d'avoir un tableau vide en feuille 2. Z'etes sur de connaitre le VBA ?? Cette ligne est en commentaire, je l'ai mise pour faire des tests tableau vide, si elle vous gene, enlevez la
Le but n'est pas d'avoir un tableau vide en feuille 2. Z'etes sur de connaitre le VBA ?? Cette ligne est en commentaire, je l'ai mise pour faire des tests tableau vide, si elle vous gene, enlevez la
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
61
Modifié par Kuartz le 30/06/2015 à 16:30
Modifié par Kuartz le 30/06/2015 à 16:30
D'accord OK merci. Je connais peu le VBA, mais je sais qu'il s'agissait d'un commentaire. J'avais mal compris et je croyais que les commentaires étaient en fait vos corrections.
f894009
Messages postés
17206
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 novembre 2024
1 709
>
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
30 juin 2015 à 17:46
30 juin 2015 à 17:46
Re,
Donc, une ligne dans tableau2 avec kakechose dans une des colonnes
DATE LETTRE RAPPEL 1 DATE LETTRE RAPPEL 2 DATE MISE EN DEMEURE DATE POURSUITE JUDICIARE ACTIONS
ne doit pas etre suprimee, meme si elle ne figure pas dans le tableau1
Donc, une ligne dans tableau2 avec kakechose dans une des colonnes
DATE LETTRE RAPPEL 1 DATE LETTRE RAPPEL 2 DATE MISE EN DEMEURE DATE POURSUITE JUDICIARE ACTIONS
ne doit pas etre suprimee, meme si elle ne figure pas dans le tableau1
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
61
30 juin 2015 à 17:53
30 juin 2015 à 17:53
Tout marche parfaitement. Je vous remercie.
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 310
30 juin 2015 à 18:03
30 juin 2015 à 18:03
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
f894009
Messages postés
17206
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
22 novembre 2024
1 709
Modifié par f894009 le 1/07/2015 à 08:59
Modifié par f894009 le 1/07/2015 à 08:59
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
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
61
1 juil. 2015 à 09:37
1 juil. 2015 à 09:37
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.
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 310
1 juil. 2015 à 10:53
1 juil. 2015 à 10:53
tu m'as pas froissé mais déçu et découragé d'essayer d'apporter de l'aide
surtout que je t'avais écrit que je testerai + tard
surtout que je t'avais écrit que je testerai + tard
30 juin 2015 à 16:28