Comparaison de données dans un même classeur

Y compris Power BI, Power Query et toute autre question en lien avec Excel
B
BastLat
Membre fidèle
Membre fidèle
Messages : 258
Inscrit le : 29 octobre 2008
Version d'Excel : EXCEL 2007 FR

Message par BastLat » 4 février 2016, 18:58

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 :)
gest.xlsm
(38.13 Kio) Téléchargé 22 fois
Modifié en dernier par BastLat le 6 février 2016, 14:16, modifié 2 fois.
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'218
Appréciations reçues : 140
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 4 février 2016, 20:36

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.
B
BastLat
Membre fidèle
Membre fidèle
Messages : 258
Inscrit le : 29 octobre 2008
Version d'Excel : EXCEL 2007 FR

Message par BastLat » 5 février 2016, 01:12

curulis57 a écrit :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.
Le code est dans la macro "MaJ"

Merci pour ta réponse ;)
B
BastLat
Membre fidèle
Membre fidèle
Messages : 258
Inscrit le : 29 octobre 2008
Version d'Excel : EXCEL 2007 FR

Message par BastLat » 6 février 2016, 14:10

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 :)
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 596
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 6 février 2016, 16:40

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
B
BastLat
Membre fidèle
Membre fidèle
Messages : 258
Inscrit le : 29 octobre 2008
Version d'Excel : EXCEL 2007 FR

Message par BastLat » 6 février 2016, 19:49

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 !!
gestsimpl.xlsm
(22.33 Kio) Téléchargé 10 fois
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 596
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 6 février 2016, 20:45

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
B
BastLat
Membre fidèle
Membre fidèle
Messages : 258
Inscrit le : 29 octobre 2008
Version d'Excel : EXCEL 2007 FR

Message par BastLat » 6 février 2016, 23:15

Klin89 a écrit :Re BastLat, :)
.....Mais non, c'est très simple à comprendre justement ;;)
Merci Klin89 de me consacrer du temps ;)

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 ;)
B
BastLat
Membre fidèle
Membre fidèle
Messages : 258
Inscrit le : 29 octobre 2008
Version d'Excel : EXCEL 2007 FR

Message par BastLat » 7 février 2016, 18:31

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
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message