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

23gest.xlsm (38.13 Ko)

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 :

  • 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

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 !!

10gestsimpl.xlsm (22.33 Ko)

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

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

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
Rechercher des sujets similaires à "comparaison donnees meme classeur"