Comparaison de données dans un même classeur
Bonsoir,
Voilà, je compare fréquemment 2 feuilles: "data" et "data_old"
Il y a souvent des ajouts/suppressions de lignes dans "data"
il y a des infos dans "data_old" qui ne sont pas dans "data" (Celles de la zone grisée)
Le but est de rapporter dans la zone grisée de "data", les infos de la zone grisée de "data_old" uniquement pour les lignes dont les colonnes "Ref1", "Ref2" et "Ref3" sont identiques.
Ce que je fais;
Je lis chaque ligne de "data", puis je regarde dans "data_old" si cette ligne existe à l'aide de 3 clefs "Ref1" puis "Ref2" et "Ref3" (Colonnes rouges dans le fichier).
Si ces 3 clefs sont identiques, je suis sur que l'élément est le même,
Je copie donc les données "Ressources", "Date" et "Statut" de "data_old" vers "data" sur la ligne correspondante.
Ça fonctionne, mais mon tableau dépasse rapidement les 500 lignes, et le processus devient très long...
N'y a t il pas moyen d'effectuer cette "comparaison" plus rapidement sans passer par des boucles ?
Il me semble que oui... Mais je ne sais pas faire.
En PJ mon fichier très très édulcoré.
Le code est dans la macro "MaJ"
Merci d'avance pour votre aide
Salut BastLat,
Deux remarques :
- comment compares-tu, actuellement ? Je ne vois pas de code ?
- tu dis comparer des LIGNES et les cellules colorées dans ton fichier-exemple sont situées dans des lignes différentes!!
Sois plus clair, stp!
Bien à toi.
curulis57 a écrit :Salut BastLat,
Deux remarques :
Sois plus clair, stp!
- comment compares-tu, actuellement ? Je ne vois pas de code ?
- tu dis comparer des LIGNES et les cellules colorées dans ton fichier-exemple sont situées dans des lignes différentes!!
Bien à toi.
Le code est dans la macro "MaJ"
Merci pour ta réponse
Bonjour,
Je pensais utiliser ce code (merci Klin89)pour résoudre mon problème (raccourcir le temps de traitement quand les données deviennent nombreuses), mais je n'y arrive pas
Option Explicit
Sub test()
Dim a, i As Long, j As Long, w
a = Sheets(1).Range("a1").CurrentRegion.Value 'source
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
ReDim w(1 To UBound(a, 2))
For i = 2 To UBound(a, 1)
For j = 1 To UBound(a, 2)
w(j) = a(i, j)
Next
.Item(a(i, 1)) = w
Next
a = Sheets(2).Range("a1").CurrentRegion.Value 'cible
For i = 2 To UBound(a, 1)
If .Exists(a(i, 1)) Then
For j = 3 To UBound(a, 2)
a(i, j) = .Item(a(i, 1))(j)
Next
End If
Next
End With
'cible
Sheets(2).Range("a1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub
Pourtant je sens que c'est la voie...
Un Dieu du VBA pourrait il se pencher sur mon cas ?
Merci d'avance
Bonjour BastLat, le forum
Essaie ceci :
Option Explicit
Sub test()
Dim a, i As Long, j As Long, w, txt As String
a = Sheets("data_old").Range("a1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
ReDim w(1 To UBound(a, 2))
For i = 2 To UBound(a, 1)
txt = Join$(Array(a(i, 2), a(i, 3), a(i, 5)), Chr(2))
For j = 1 To UBound(a, 2)
w(j) = a(i, j)
Next
.Item(txt) = w
Next
a = Sheets("data").Range("a1").CurrentRegion.Value
For i = 2 To UBound(a, 1)
txt = Join$(Array(a(i, 2), a(i, 3), a(i, 5)), Chr(2))
If .Exists(txt) Then
For j = 9 To UBound(a, 2)
a(i, j) = .Item(txt)(j)
Next
End If
Next
End With
'restitution dans la 3ème feuille de ton classeur
Sheets("Feuil1").Range("a1").Resize(UBound(a, 1), UBound(a, 2)).FormulaLocal = a
End Sub
klin89
Merci Klin89, mais ça ne correspond pas à ce que je recherche
Je me suis surement mal expliqué.
Je vais essayer d'être plus clair.
Le but est de renseigner la partie grisée de la feuille "data" en la comparant avec la feuille "data_old"
Dans le nouveau fichier joint, j'ai rendu ça plus clair.
je lis chaque ligne de "data", puis je regarde si elle existe dans "data_old" en me basant sur les colonnes "Ref1, "Ref2, et "Ref3"
Si elle existe, alors je copie les infos de la partie grisée de cette ligne de "data_old" vers la partie grisée de la ligne correspondante dans "data"
Dans l'exemple joint, on voit que pour les lignes surlignées en jaune elles existent à la fois dans "data" et "data_old" car les 3 "Ref" sont identiques, alors je recopie les infos de la zone grisée de "data_old" vers la zone grisée de "data"
Par contre on ne retrouve pas les lignes 2 et 4 de "data" dans "data_old", l'une à cause de "Ref2" et l'autre à cause de "Ref1", donc pas de traitement.
Enfin, la ligne 7 de data est nouvelle, donc pas de traitement non plus.
Ouf !
Je pensais que le code que tu m'as indiqué pouvait servir à ça, car se je ne me trompe pas, il utilise des tableaux, qui doivent être plus rapides que mes boucles... Mais "CreateObject("Scripting.Dictionary")" c'est du grec pour moi
Voilà.. Si vous avez eu le courage de tout lire, et si en plus quelqu’un peut m'aider, je vous en remercie d'avance !!
Re BastLat,
BastLat a écrit :
Mais "CreateObject("Scripting.Dictionary")" c'est du grec pour moi
Mais non, c'est très simple à comprendre justement
Option Explicit
Sub test()
Dim a, i As Long, j As Long, w, txt As String
a = Sheets("data_old").Range("a1").CurrentRegion.Value
'Creation du dictionnaire
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
ReDim w(1 To 5)
For i = 2 To UBound(a, 1)
'On determine les clés du dictionnaire
txt = Join$(Array(a(i, 2), a(i, 3), a(i, 5)), Chr(2))
For j = 9 To UBound(a, 2)
w(j - 8) = a(i, j)
Next
'on associe le tableau de 5 éléments à la clé concernée
.Item(txt) = w
Next
a = Sheets("data").Range("a1").CurrentRegion.Value
ReDim w(1 To UBound(a, 1) - 1, 1 To 5)
For i = 2 To UBound(a, 1)
txt = Join$(Array(a(i, 2), a(i, 3), a(i, 5)), Chr(2))
If .Exists(txt) Then
For j = 1 To UBound(w, 2)
w(i - 1, j) = .Item(txt)(j)
Next
End If
Next
End With
'restitution
Sheets("data").Range("i1").Offset(1).Resize(UBound(w, 1), UBound(w, 2)).FormulaLocal = w
End Sub
klin89
Merci Klin89 de me consacrer du tempsKlin89 a écrit :Re BastLat,
.....Mais non, c'est très simple à comprendre justement
J'étais très enthousiaste, car ton code fonctionne impec sur le fichier exemple que j'ai joint, mais,
J'ai essayé de l'adapter sur mon "vrai" fichier qui est beaucoup plus volumineux en terme de données,
et je n'y arrive pas. Pour l'instant ça bloque sur la ligne:
For j = 9 To UBound(a, 2)
w(j - 8) = a(i, j)
avec le message "l'indice n'appartient pas à la sélection".
De plus, je ne comprends pas pourquoi 9 dans "j-9" où 8 dans "w(j-8)" ...
Pourrais tu me retourner le code, en commentant l'action de chaque ligne ?
Je voudrais arriver à comprendre, et non pas copier/coller une procédure "qui fonctionne".
(je me suis même relevé cette nuit pour tester un truc... !!)
Merci en tout cas, même si tu n'as pas le temps de satisfaire cette demande, car j'ai l'outil dans les mains, et je continue à chercher
Ok, je pense que j'ai compris.
Comme mon tableau de travail a plus de 13 colonnes
J'ai remplacé
For j = 9 To UBound(a, 2)
par
For j = 9 To 13
Et il n'y a plus d'erreur.
Maintenant, si quelqu'un qui lit couramment le VBA pouvais m'expliquer les lignes comme j'ai commencé à le faire sur la première partie, ça me rendrait peut être plus.... autonome
Merci pour votre aide !
Option Explicit
Sub test()
Dim a, i As Long, j As Long, w, txt As String
'mémorise l'intégralité de la feuille "dep_col_old"
a = Sheets("dep_col_old").Range("a1").CurrentRegion.Value
'Creation du dictionnaire
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
ReDim w(1 To 5) 'tableau de la colonne des infos (5 colonnes)
For i = 2 To UBound(a, 1) 'lecture des lignes de a (feuille) à partir de la ligne 2
'On determine les clés du dictionnaire
txt = Join$(Array(a(i, 2), a(i, 3), a(i, 5)), Chr(2)) 'String qui combine les 3 clés de chaque ligne
For j = 9 To 13 'UBound(a, 2)
w(j - 8) = a(i, j) 'on construit le tableau w (5 dimensions (9 à 13)) à partir de l'ind1 (9-8)
Next
'on associe le tableau de 5 éléments à la clé concernée
.Item(txt) = w
Next
a = Sheets("dep_col").Range("a1").CurrentRegion.Value
ReDim w(1 To UBound(a, 1) - 1, 1 To 5)
For i = 2 To UBound(a, 1)
txt = Join$(Array(a(i, 2), a(i, 3), a(i, 5)), Chr(2))
If .Exists(txt) Then
For j = 1 To UBound(w, 2)
w(i - 1, j) = .Item(txt)(j)
Next
End If
Next
End With
'restitution
Sheets("dep_col").Range("i1").Offset(1).Resize(UBound(w, 1), UBound(w, 2)).FormulaLocal = w
End Sub