Optimiser code en utilisant des tableaux
Bonjour à tous,
J'ai une macro permettant de comparer les données de deux feuilles, elle fonctionne mais le problème est que son temps d'exécution est très long.
En voilà le code :
Sub ComparaisonCDR()
'Déclarations
Dim valeurA As String, valeurB As String 'Valeurs des cellules de la feuille 1
Dim valeurC As String, valeurD As String
Dim valeurE As String, valeurF As String
Dim valeurG As String, valeurH As String
Dim valeurI As String, valeurJ As String
Dim valeurAll As String
Dim valeur1 As String, valeur2 As String 'Valeurs des cellules de la feuille 2
Dim valeur3 As String, valeur4 As String
Dim valeur5 As String, valeur6 As String
Dim valeur7 As String, valeur8 As String
Dim valeur9 As String, valeur10 As String
Dim valeur11 As String
Dim nblignesA As Long, nblignes1 As Long 'Position de la dernière cellule non vide
Dim i As Long, j As Long
'MsgBox ("Veuillez patienter, cela peut prendre quelques minutes...")
Application.ScreenUpdating = False
nblignesA = Workbooks("Comparaison_Forum.xlsm").Worksheets("Import1").Range("A" & Rows.count).End(xlUp).row
nblignes1 = Workbooks("Comparaison_Forum.xlsm").Worksheets("Import2").Range("A" & Rows.count).End(xlUp).row
'Compare toutes les valeurs de Import_CDR avec toutes celles de Import_Billrun
For j = 2 To nblignes1
Workbooks("Comparaison_Forum.xlsm").Worksheets("Import2").Activate
valeur1 = Cells(j, 1).value
valeur2 = Cells(j, 2).value
valeur3 = Cells(j, 3).value
valeur4 = Cells(j, 4).value
valeur5 = Cells(j, 5).value
valeur6 = Cells(j, 6).value
valeur7 = Cells(j, 7).value
valeur8 = Cells(j, 8).value
valeur9 = Cells(j, 9).value
valeur10 = Cells(j, 10).value
For i = 1 To nblignesA
Workbooks("Comparaison_Forum.xlsm").Worksheets("Import1").Activate
valeurA = Cells(i, 1).value
valeurB = Cells(i, 2).value
valeurC = Cells(i, 3).value
valeurD = Cells(i, 4).value
valeurE = Cells(i, 5).value
valeurF = Cells(i, 6).value
valeurG = Cells(i, 7).value
valeurH = Cells(i, 8).value
valeurI = Cells(i, 9).value
valeurJ = Cells(i, 10).value
valeurAll = valeurA + valeurB + valeurC + valeurD + valeurE + valeurF + valeurG + valeurH + valeurI + valeurJ
valeur11 = valeur1 + valeur2 + valeur3 + valeur4 + valeur5 + valeur6 + valeur7 + valeur8 + valeur9 + valeur10
If StrComp(valeurAll, valeur11) = 0 Then
Worksheets("Import2").Cells(j, 11).Interior.Color = RGB(0, 255, 0)
Worksheets("Import2").Cells(j, 11).value = "OK"
Exit For
End If
Next i
If StrComp(valeurAll, valeur11) <> 0 Then
Worksheets("Import2").Cells(j, 11).Interior.Color = RGB(255, 0, 0)
Worksheets("Import2").Cells(j, 11).value = "KO"
End If
Next j
Application.ScreenUpdating = True
Workbooks("Comparaison_Forum.xlsm").Worksheets("Import2").Activate
End SubComme vous pouvez le voir, mon code compare les cellules une par une. Ce que j'aimerais faire, c'est de rentrer toutes les données dans un tableau et de les comparer directement, afin d'augmenter la vitesse d'exécution de cette macro.
En PJ, un .xlsm représentatif de mon vrai fichier, avec beaucoup de données en moins. (sur mon fichier originel, il y a environ 6200 lignes sur la feuille1 et 120 sur la 2e, chaque feuille comportant 10 colonnes à comparer, et le code met environ 2-3 minutes à s'éxecuter)
Si vous avez besoin de précisions, n'hésitez pas !
Merci d'avance !
EDIT : J'apporte quelques précisions :
Cette macro sert à comparer les données entre deux feuilles, et colore en vert et inscrit "OK" dans la colonne K de la feuille 2 à la ligne dont les données existent dans la feuille 1. Elle inscrit "KO" et colore la cellule en rouge si ces données n'existent pas dans la feuille 1.
Je voudrais simplement remplacer la comparaison cellule par cellule par une comparaison par tableaux.
Bonjour, comment doit se faire la comparaison ?
Ligne 1 / ligne 1 de chaque feuille ?
Ou alors référence ligne 1 feuille 1 , recherche de la même référence en feuille 2 puis comparaison des colonnes...
Bonjour à toi,
Deuxième option, on prend une ligne dans la feuille 2 et on la compare avec les lignes de la feuille 1 pour voir si les données correspondent.
Je voudrais ranger les données de la feuille 1 dans un tableau et celles de la feuille 2 dans un autre, puis les comparer, et à priori le code s'exécutera beaucoup plus vite qu'avec ma méthode actuelle.
Dans la feuille 1 colonne A il peut y avoir des doublons ? et d'ailleurs est-ce que l'on doit se servir que de la colonne A pour savoir ce que l'on doit comparer ?
Non, il ne peut pas y avoir des doublons, s'il y en a dans le fichier que j'ai joint, je n'ai pas du faire gaffe sous le coup de la précipitation.
Il faut que toutes les valeurs d'une ligne d'une feuille correspondent à toutes les valeurs d'une ligne de l'autre feuille, donc il faut toutes les comparer.
EDIT : Ces deux lignes dont les données correspondent ne doivent pas nécessairement être au même numéro de ligne, la ligne 12 de la feuille 1 peut correspondre à la ligne 4 de la feuille 2.
ce que je voulais savoir c'est avec quelle colonne de la feuille 2 on se repère pour chercher dans la feuille1 la référence à trouver. A priori ce sera avec la colonne A si je devine bien.
C'est à dire :
recherche dans la feuille 1 l'ip de la première cellule de la feuille 2 puis comparer les colonnes...
Oui voilà en gros c'est ça ! Chose que je ne sais pas faire en utilisant les tableaux...
Ne soyez pas inquiet...IL y en a ici qui savent ! J'suis même sur qu'une réponse similaire existe!
Bonjour
Bonjour Force rouge
Une version sans tableau
A tester pour le fun
Bonjour,
Je vais essayer ça de suite !
Je n'ai pas précisé, mais ce n'est pas nécessaire que ce soit un tableau, il faudrait juste que mon code s'exécute plus rapidement..
Je reviens en début de soirée, si personne n'a proposé de solution d'ici là j'en posterai une pour comparer avec la votre le temps d'execution
Dis-moi Banzai, que faudrait-il modifier pour le faire dans le sens inverse ? Par le sens inverse j'entend prendre une ligne de la feuille 1 et la comparer avec la feuille 2, et si elle existe dans la feuille 2, colorer la colonne K de la première feuille.
Merci beaucoup!
Bonjour
bonjour Force Rouge
Re Banzai...
Ci joint une version avec des tableaux (voir le module 1)
fred
Edit il manque peut-etre le sheets(2).activate a la fin
Bonjour,
Une possibilité en pièce jointe.
Nota : La ligne 8 sort en rouge car c'est un doublon de la ligne 5...
Les colorations sont en fait des MFC (Mise en forme conditionnelles)
Je ne me suis pas occupé de colorer la feuille1 car ça ne faisait pas parti du problème d'origine mais ce n'est pas plus compliqué...
A+
Merci beaucoup à vous ! Je n'ai plus le temps pour essayer ce soir, mais j'essaierai ça demain !
Bonjour
Blodsvept a écrit :que faudrait-il modifier pour le faire dans le sens inverse ?
Ne rien modifier il faut rajouter une 2ème boucle
A tester
Banzai64 a écrit :Bonjour
Ne rien modifier il faut rajouter une 2ème boucle
Idem pour moi !
A noter que les doublons subissent un sort différent : La première version était vraiment orientée gain de temps, la recherche de doublons n'a pas été poursuivie... Mais de toute façon sur une centaine de lignes je doute fort que la différence soit perceptible !
A+
Bonjour alllllllllllllll the world...J'suis rescapé d'un spectacle de deux heures à écouter des gamins qui braillent avec un orchestre aux tronches de lendemain de cuite. J'ai pas tout compris à l'histoire qu'ils nous ont raconté mais ils ont mis un an de préparation pour faire un truc qui n'a ni queue ni tête...Bon bref, j'ai pas regardé les fichiers de tout le monde et j'ai fait une méthode find...blodsvept n'aura que l'embarra du choix pour tester la solution la plus perfomante...
Bonjour à tous !
Tout d'abord, je tiens à vous remercier pour toutes ces réponses !
Le code de galopin01 est ce qui correspond le plus à ce que je recherchais, et c'est aussi le plus rapide à l'éxecution ! (Plus ou moins 2 secondes, alors que mon ancien code prenait au moins 2-3 minutes.) Les autres fonctionnent aussi très bien, mais c'est vraiment des tableaux qu'il me fallait :p
Merci encore à vous tous et bonne continuation !
(J'ai oublié, si c'est possible que tu me commente ton code galopin histoire que je le comprenne un peu mieux, ce serait vachement sympa !
bonjour,
Option Explicit
Option Compare Binary
DefBool Y 'Les variables dont le nom commence par Y sont des Boolean
Sub ComparaisonCDR()
Dim WsS As Worksheet, WsC As Worksheet, ILRS&, iLRC&, ArrS(), ArrC(), kRS&, kRC&, kC%, Y, YF
Set WsS = Worksheets("Import1") 'feuille Source
Set WsC = Worksheets("Import2") 'feuille Cible
ILRS = WsS.Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne feuille Source
iLRC = WsC.Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne feuille Cible
ArrS() = WsS.Range("A1:K" & ILRS) 'Tableau Source
ArrC() = WsC.Range("A1:K" & iLRC) 'Tableau Cible
For kRS = 1 To ILRS 'Pour chaque ligne de tableau Source
For kRC = 1 To iLRC 'parcourir chaque ligne de tableau cible
For kC = 1 To 10 'et chaque colonne de chaque ligne
If ArrS(kRS, kC) <> ArrC(kRC, kC) Then 'Dès qu'on rencontre une divergence
YF = True 'On pose un drapeau pour passer à la ligne suivante de la cible (kRC)
Exit For 'et on sort (inutile de continuer pour rien...)
End If
If kC = 10 And ArrS(kRS, kC) = ArrC(kRC, kC) Then 'Si on n'est pas sorti c'est qu'on est Ok jusqu'à la 10ème colonne
ArrC(kRC, 11) = "Ok" 'Dans ce cas on met le "Ok" sur la colonne 11 du tableau Cible
ArrS(kRS, 11) = "Ok" 'Et du tableau Source
Y = True 'On met un drapeau pour passer à la ligne suivante de la source (kRS)
Exit For 'Et on sort (inutile de chercher un doublon dans la Cible)
End If
Next 'Et on passe à la colonne suivante de la cible (s'il n'y a pas de drapeau)
If YF Then YF = False 'on réinitialise les drapeaux avant de passer au kRC suivant
If Y Then Exit For 'On saute cette boucle car on ne cherche pas de doublon dans la cible
Next 'On passe à la ligne suivante de la cible (s'il n'y a pas de drapeau)
If Y Then Y = False 'Et on réinitialise le drapeau pour
Next 'passer à la ligne source suivante
For kRS = 1 To ILRS 'Pour chaque ligne de tableau source
WsS.Cells(kRS, 11) = ArrS(kRS, 11) 'Si on a mis le "Ok" colonne 11, on le recopie sur la feuille
If WsS.Cells(kRS, 11) = "" Then WsS.Cells(kRS, 11) = "KO" 'Et si on n'a rien dans le tableau source on met un "KO" sur la feuille
Next
For kRC = 1 To iLRC 'Pour chaque ligne de tableau cible
WsC.Cells(kRC, 11) = ArrC(kRC, 11) 'Si on a mis le "Ok" colonne 11, on le recopie sur la feuille
If WsC.Cells(kRC, 11) = "" Then WsC.Cells(kRC, 11) = "KO" 'Et si on n'a rien dans le tableau source on met un "KO" sur la feuille
Next
WsC.Activate
End SubLe code sera plus lisible si tu le recopie "en bloc" dans ton module...
A+