VBA - Comparer deux tableaux de structure identique

Question

Je poste ici car j'ai créé une macro (en m'inspirant de ce que j'ai trouvé sur le web, soyons modeste) qui permet de comparer des données et j'ai remarqué que pour un grand nombre de lignes, c'est très long. J'ai même l'impression que plus la macro avance dans les lignes, et plus c'est lent. Je pose ma question tout de suite et je détaille après : peut-on l'optimiser ? En référence, j'ai comparé 2 fois des tableaux de 100 000 lignes et ça a mis environ 1h. La première fois je pense qu'il y avait 5 colonnes à comparer (+ l'ID) et la seconde fois 7 colonnes (+ l'ID). Le temps passé par la macro est peut être normal vu la volumétrie, mais je souhaite savoir si on peut l'optimiser. Voici le fonctionnement : 1er onglet : les données de référence, avec la clé en colonne A (identifiant unique) 2ème onglet : les données à comparer, avec la clé en colonne A (identifiant unique) 3ème onglet, un bouton pour lancer la macro La macro (stockée dans le 3ème onglet) : Copie la ligne d'en-tête du 1er onglet dans le 3ème. Va lire dans le 1er onglet la clé (colonne A) et la recherche dans le 2ème onglet via un Find. Si elle trouve cette clé, elle va comparer colonne par colonne les valeurs de la ligne de cet ID entre le 1er onglet et le 2nd. Elle marque les lignes dont au moins une valeur est modifiée en ajoutant un "X" en colonne XX. Chaque cellule en écart est colorisée en jaune Elle indique "modifiée" dans la colonne suivant la dernière colonne de données Les ID du 1er onglet non trouvés dans le 2ème onglet sont marqués comme nouveaux dans cette même colonne Les ID du 2ème onglet non trouvés dans le 1er onglet sont marqués comme nouveaux dans cette même colonne Si aucune valeur n'est en modifiée, aucun ID créé ou supprimée, une variable permet de le savoir à la fin et une MsgBox l'affiche. Un userform permet de connaitre l'avancement de la macro : temps d'exécution, ligne en cours de traitement, nombre total de lignes à traiter, et donc % d'avancement Exemple : 1er onglet A B C toto 1 abc tata 2 xy 2ème onglet A B C toto 8 abc tutu 3 123 1er onglet A B C D toto 8 abc modifiée (j'ai mis le 8 en gras mais dans Excel sa cellule est sur fond jaune) tata 2 xy supprimée tutu 3 123 nouvelle Je joins la macro avec cet exemple très simple (et très rapide) pour plus de compréhension. Merci beaucoup pour l'aide apportée ! Bonne soirée François...

AlgoPlus · Answer

Un essai avec tableau (array) et dictionary qui devraient permettre de gagner énormément de temps. Ca fonctionne sur le classeur exemple, mais un jeu d'essai plus étoffé aurait permis de meilleurs tests. Sub Compare() Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet Dim i As Long, j As Byte, Ind As Long Dim NbModif As Long, NBNouv As Long, NBSup As Long, NbLi As Long Dim Modif As Boolean Dim T1, T2, T3, Dico, Cle Application.ScreenUpdating = False Set F1 = Worksheets("Original") Set F2 = Worksheets("A_comparer") Set F3 = Worksheets("Résultat") T1 = F1.Range("A1").CurrentRegion T2 = F2.Range("A1").CurrentRegion ReDim T3(1 To UBound(T1, 1), 1 To UBound(T1, 2) + 1) Set Dico = CreateObject("Scripting.Dictionary") '**Copie ligne entête F1.Rows(1).Copy F3.Range("A1") 'création dictionary avec clé et N° ligne de T2 For i = LBound(T2, 1) To UBound(T2, 1) Dico(T2(i, 1)) = i Next '****traitement Modifié et Supprimé For i = LBound(T1, 1) To UBound(T1, 1) Modif = False If Dico.Exists(T1(i, 1)) Then 'si t1 existe dans T2 'vérification des "champs" For j = 2 To UBound(T1, 2) If T2(i, j) &lt;&gt; T1(Dico(T1(i, 1)), j) Then Modif = True Next If Modif Then NbModif = NbModif + 1 NbLi = NbLi + 1 For j = 1 To UBound(T1, 2) T3(NbLi, j) = T2(Dico(T1(i, 1)), j) Next T3(NbLi, UBound(T3, 2)) = "Modifiée" 'Dico.Remove (T1(i, 1)) End If Dico.Remove (T1(i, 1)) Else ' si T1 n'existe pas dans T2 NBSup = NBSup + 1 NbLi = NbLi + 1 For j = 1 To UBound(T2, 2) T3(NbLi, j) = T1(i, j) Next T3(NbLi, UBound(T3, 2)) = "Supprimée" End If Next '*** traitement nouvelle For Each Cle In Dico.keys NBNouv = NBNouv + 1 NbLi = NbLi + 1 Ind = Dico(Cle) For j = 1 To UBound(T2, 2) T3(NbLi, j) = T2(Ind, j) Next T3(NbLi, UBound(T3, 2)) = "Nouvelle" Next '* "collage" du résultat F3.Range("A2").Resize(NbLi, UBound(T3, 2)) = T3 Application.ScreenUpdating = True If NbModif + NBSup + NBNouv &gt; 0 Then MsgBox NbModif &amp; " lignes modifiées" &amp; vbLf &amp; NBSup &amp; " lignes supprimées" &amp; vbLf &amp; NBNouv &amp; " lignes nouvelles" End Sub Le fond jaune des modif n'est pas pris en compte.Ce n'est pas possible directement par tableau. Si après essais le gain de temps est significatif (combien ?), je m'y pencherai. A+...

AlgoPlus · Answer

Je suis parti du principe que T1 et T2 avait le même nombre de colonnes (dans l'exemple du classeur 3) Dès que ces tableaux sont initialisés, je redimentionne T3 (qui contiendra les résultats) la deuxième dimension= 1 To UBound(T1, 2) + 1 soit dans l'exemple : 4 , donc une de plus pour mettre l'info (modifiée, supprimée ...) la première dimension je l'ai dimentionné arbitrairement sur la première dimension de T1 pensant qu'il n'y aurait pas beaucoup de lignes à signaler, donc: 1 To UBound(T1, 1) En fait il peut y avoir autant d'anomalies que de ligne en T1 plus toutes les lignes de T2 inconnues en T1, soit une première dimension qui devrait être : taille de T1 + pratiquement taille de T2 L'erreur se déclenche parce qu'on essaye d'écrire plus de lignes que T3 ne peut en contenir . En modifiant le ReDim T3 en ReDim T3(1 To UBound(T1, 1) + UBound(T2, 1), 1 To UBound(T1, 2) + 1) ça va passer! Par ailleurs, aucun traitement n'est réalisé en feuille "Original" : les lignes n'existant plus en feuille "A_comparer" ne sont pas supprimées les lignes nouvelles en feuille "A_comparer" ne sont pas ajoutées les lignes existantes de chaque coté avec des valeurs différentes ne sont pas mises à jour Faut-il l'envisager ? A+...

AlgoPlus · Answer

Ben oui... je ne comprend pas comment ça ramenait les bonnes valeurs !!

If T2(i, j) <> T1(Dico(T1(i, 1)), j) Then Modif = True

est absurde. évidemment il faut :

  If T1(i, j) <> T2(Dico(T1(i, 1)), j) Then Modif = True

pour mettre en évidence les valeurs modifiées deux solutions:

1) indiquer dans une colonne supplémentaire de T3 les N° de colonnes modifiées.

"coller" le tableau dans la feuille résultat

rajouter une moulinette dans la macro , qui va parcourir cette colonne supplémentaire pour colorer les colonnes nécessaires

supprimer cette colonne supplémentaire.

2)dans la feuille résultats ne copier que les valeurs qui ont été modifiées, les autres restant vides.

( sauf la clé )

A+

AlgoPlus · Answer

Si la macro n'est pas lancée depuis la feuille de résultats ( a priori ça n'arrivera pas , mais ...)la couleur risque de ne pas être mise sur la bonne feuille:

 F3.Cells(i + 1, k).Interior.ColorIndex = 6 ' On colorise les cellules...

Pour la coloration des lignes:

Les dernières lignes de T3 sont les lignes nouvelles, donc les premières sont les lignes modifiées et les lignes supprimées dans le désordre.

For i = 1 To NbModif, ne parcourra pas l'ensemble des lignes modifiées et supprimées

il faudrait :

For i = 1 To NbModif + NBSup

Si T1 n'a que 3 colonnes (comme dans le classeur test) avec avec For j = 0 To UBound(T1, 2) - 2 , on se limite à la première "colonne". Il faudrait peut -être

For j = 0 To UBound(T3, 2) - 2

Finalement, pas sûr que cette ligne soit indispensable.... à voir

Bonne soirée

Edit : 15 s au lieu d'une heure , ça valait le coup d'optimiser.

Dommage pour le module de visualisation de l'avancement du traitement ...

AlgoPlus · Answer

Pour la gestion des colonnes à coloriser:

puisque ces N° de colonnes sont stockés dans un tableau (ColModifs) pendant le traitement, autant utiliser ce tableau par balayage pour connaitre les colonnes à coloriser.

'***Traitement des cellules modifiées
    For i = 1 To NbModif + NBSup
        'For j = 0 To UBound(T1, 2) - 2 'ligne supprimée
            If T3(i, UBound(T3, 2) - 1) = "Modifiée" Then
                k = T3(i, UBound(T3, 2)) 'on met le tableau des N° de colonnes dans un tableau k
                For x = LBound(k) To UBound(k) 'du premier au dernier élément de k
                    If k(x) > 0 Then Cells(i + 1, k(x)).Interior.ColorIndex = 6  ' On colorise les cellules modifiées
                Next
            End If
        'Next
    Next

    MsgBox NbModif & " lignes modifiées" & vbLf & NBSup & " lignes supprimées" & vbLf & NBNouv & " lignes nouvelles"

Else
.../...

ce qui oblige à modifier la déclaration de k (à déclarer comme ColModifs) et à déclarer x as long

Peut-être prévoir un Erase du tableau ColModifs, qui pourrait conserver des données de l'itération précédente.

C'est tout pour aujourd'hui ...

AlgoPlus · Answer

Mea culpa : je n'avais pas fait attention au ReDim. 4 secondes , colorisation comprise ! je pensais que cette étape serait plus gourmande ! Bon courage et bonne suite...