Optimiser une macro de comparaison de feuilles Excel

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Optimiser une macro de comparaison de feuilles Excel

Soft7777777

Bonjour,

Je viens de m'inspirer d'un code arrangé selon les besoins recherchés.

En gros, j'ai 2 feuilles dans le même workbook Excel que je compare.
La comparaison a pour objectif de détecter les similitudes et différences des lignes.
Les 2 fichier ont la même organisation (colonnes) mais les lignes ne sont pas dans le même ordre d'apparition.

Résultats:

Si ligne trouvée alors celle ci apparait en vert sur une feuille et sur l'autre message indiquant "Trouvé"
Si la ligne n'est pas trouvée, la première cellule est en rouge + message "non trouvé" + coloration en orange de la dernière cellule non trouvée.

Problème:

Le fichiers comportent parfois + de 300 000 lignes et le temps est très très long (environ 1h)

Je suis pas très habitué au VBA donc je ne vois pas pourquoi cette lenteur d'autant que j'utilise des tableaux pour la comparaison.

A L'AIDE SVP.

Code :

Sub Comparaison()
Dim nbLigneAIA As Long
Dim nbLigneCRI As Long
' ------------ Compteurs de boucles - - - - - - - - - - - -
Dim i As Long
Dim j As Long
Dim nbCol As Integer
Dim e_AIA As Long
Dim e_CRI As Long
' ------------ Booléens - - - - - - - - - - - -
Dim Y As Boolean
Dim WbA As Workbook, WbN As Workbook
Dim WsA As Worksheet, WsN As Worksheet
' ------------ Initialisation Workbook et Sheets - - - - - - - - - - - -
Set WbA = Workbooks("Automatisation_RQT_V3.xlsm" )
Set WbN = Workbooks("Automatisation_RQT_V3.xlsm" )
Set WbData = Workbooks("Automatisation_RQT_V3.xlsm" )
Set WsA = WbA.Worksheets("Req_AIA" )
Set WsN = WbN.Worksheets("Req_CRI" )
' ------------ Détermination des tailles des 2 fichiers - - - - - - - - - - - -
With Sheets("Req_AIA" )
nbLigneAIA = .Range("B" & .Rows.Count).End(xlUp).Row
End With
With Sheets("Req_CRI" )
nbLigneCRI = .Range("B" & .Rows.Count).End(xlUp).Row
End With
'L 'utilisateur choisit le nombre de colonnes à comparer
nbCol = Workbooks("Automatisation_RQT_V3.xlsm" ).Sheets("Donnees" ).Range("B1" ).Value + 1
' ------------ Tableaux - - - - - - - - - - - -
Dim TabloAIA() As Variant
Dim TabloCRI() As Variant
' Initialisation des booléens
Y = False
TabloAIA() = WsA.Range("B2:Q" & nbLigneAIA)
TabloCRI() = WsN.Range("B2:Q" & nbLigneCRI)
'TabloAIA() = WsA.Range(Cells(1, 1), Cells(nbLigneAIA, nbCol + 1))
'TabloCRI() = WsN.Range(Cells(1, 1), Cells(nbLigneCRI, nbCol + 1))
'Détermination des absents
For i = 2 To nbLigneAIA
Y = False
For j = 2 To nbLigneCRI
' Tester si la ligne n'a pas déjà été trouvée avant
'If WsN.Cells(j, nbCol + 1) <> "Trouvé" Then
If TabloCRI(j - 1, nbCol) <> "Trouvé" Then
If TabloAIA(i - 1, 1) = TabloCRI(j - 1, 1) Then
'Si égalité alors on pose un drapeau
Y = True
WsA.Cells(i, 2).Interior.ColorIndex = 4
'et on vérifie la ligne si c'est une égalité stricte
For k = 3 To nbCol
' Si égalité alors on colorie la cellule en vert
'If WsA.Cells(i, k) = WsN.Cells(j, k) Then
If TabloAIA(i - 1, k - 1) = TabloCRI(j - 1, k - 1) Then
WsA.Cells(i, k).Interior.ColorIndex = 4
Else
'Si la cellule en cours n'est pas déjà en vert alors on la met en orange (Eviter l'écrasement de couleur = indiquer la bonne cellule manquante)
If WsA.Cells(i, k).Interior.ColorIndex <> 4 Then
'Ys = True
'et on colore en orange
WsA.Cells(i, k).Interior.ColorIndex = 45
Y = False
Exit For
End If
End If
Next
End If
'Si on trouve la ligne on sort immédiatement du 2 ieme For (éviter de parcours le reste pour rien)
If Y Then Exit For
End If
Next
If Y = True Then
'Marquer dans le fichier CRI les lignes trouvées pour éviter de laisser passer les doublons
'WsN.Cells(j, nbCol + 1) = "Trouvé"
TabloCRI(j - 1, nbCol) = "Trouvé"
Else
'Si pas trouvé alors on colorie la ligne AIA en rouge
WsA.Range("B" & i).Interior.ColorIndex = 3
'WsA.Cells(i, nbCol + 1) = "Non Trouvé"
TabloAIA(i - 1, nbCol) = "Non Trouvé"
End If
Y = False
Next
'MAJ des états dans les feuilles
For e_AIA = 1 To nbLigneAIA - 1
WsA.Cells(e_AIA + 1, nbCol + 1) = TabloAIA(e_AIA, nbCol)
Next
For e_CRI = 1 To nbLigneCRI - 1
WsN.Cells(e_CRI + 1, nbCol + 1) = TabloCRI(e_CRI, nbCol)
Next
Erase TabloAIA
Erase TabloCRI
Set WbA = Nothing
Set WbN = Nothing
Set WsA = Nothing
Set WsN = Nothing
End Sub

Publicité

vttman2

Je suis Open ...

Bon excel traitant 300 000 lignes why not ?

1ere solution : Prendre un PC plus musclé :sleep:

2eme solution: Modifier l'algo pour chercher une ligne de la 1ere feuille
en parcourant un minimum de lignes de la 2eme feuille
car il me semble que pour chaque ligne de la 1ere feuille, on attaque la
recherche sur l'ensemble des lignes de la 2eme :ouch:

Proposition
=> On s'arrange pour trier les 2 feuilles ex :

Feuille 1
donnée A
donnée C
donnée B
rajout d'une info de tri (champ temporaire contenant 1, 2, 3 ...)
=>
Feuille 1
1donnée A
2donnée C
3donnée B

Feuille 2
donnée D
donnée B
donnée A
rajout d'une info de tri
=>
Feuille 2
1donnée D
2donnée B
3donnée A

Tri de Feuille1 et Feuille2 sur 2eme champ et comparaison
des lignes en avançant sur les 2 feuilles en même temps

Feuille 1
1donnée A TROUVé
3donnée B TROUVé
2donnée C PAS TROUVé
et
Feuille 2
3donnée A TROUVé
2donnée B TROUVé
1donnée D PAS TROUVé

Puis remise des feuilles dans l'ordre du 1er champ

Feuille 1
1donnée A TROUVé
2donnée C PAS TROUVé
3donnée B TROUVé
et
Feuille 2
1donnée D PAS TROUVé
2donnée B TROUVé
3donnée A TROUVé

Je ne sais pas si c'est clair et facilement faisable en VBA
mais là ça serait déjà plus rapide ...en restant sous Excel

---------------
il n'y a pas que le VTT dans la vie, il y a le Snowboard aussi ...

galopin01

Oups... C'est parti trop vite : message remplacé

Message édité par galopin01 le 12-11-2011 à 17:50:24

galopin01

Bonjour,
Soft7 : Je t'ai répondu sur le forum d'origine en te proposant de m'envoyer ton fichier :

Citation :

Merci de m'envoyer Automatisation_RQT_V2.xlsm avec les 2 feuilles "Req_AIA" et "Req_CRI" à l'adresse que je t'ai mis en MP

Tu n'as même pas ouvert la messagerie :

Inutile d'arroser tous les forums du Net : tu n'auras pas de réponses plus pertinente sur ce code.
Visiblement tu as déjà compris pas mal de chose puisque tu as supprimé le pire : les Redim et les Delete...
Demande si tu as encore des zones d'ombre je ne demande pas mieux que de rabacher mais évite de te balader partout je ne peux pas suivre ton fil d'un forum à l'autre... :pt1cable:

Je t'ai affirmé avoir testé l'algo d'origine sur 20 000 000 de cellules (soit 500 000 lignes x 40 colonnes) avec un temps de traitement de 2 minutes ce qui correspond bien au gain de temps espéré en utilisant des Array.
Je n'ai pas analysé complètement ta nième version, mais à priori -si le reste est juste- c'est surtout les 5 dernières lignes 109 à 114 qui ralentissent ton code et qui bouffent la majorité de ton temps de process...

Si ligne (49 et 50) :

Code :

TabloAIA() = WsA.Range("B2:Q" & nbLigneAIA)
TabloCRI() = WsN.Range("B2:Q" & nbLigneCRI)

Alors tu peux avantageusement remplacer les lignes 109 à 114 par

Code :

WsA.Range("B2:Q" & nbLigneAIA) = TabloAIA()
WsN.Range("B2:Q" & nbLigneCRI) = TabloCRI()

Et à mon avis tu devrais avoir gagné pas loin de 50 minutes pour peu que tu rajoutes (au début de ta procédure) :

Code :

Application.ScreenUpdating = False

A+

Message édité par galopin01 le 12-11-2011 à 17:48:44

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Optimiser une macro de comparaison de feuilles Excel

Sujets relatifs
Macro pour défusionner un document obtenu par publipostage	Macro multi-critères
Excel - Problème de suppression d'onglets si objets présents	Gestion de document Word via macro VBA excel
Formule Excel pour compter des cellules remplies	Toute petite macro VBA pour enregistrement
Macro sous excel	Executer le code d'un bouton Access sous Excel
Plus de sujets relatifs à : Optimiser une macro de comparaison de feuilles Excel

Page générée en 0.072 secondes