Optimiser une macro de comparaison de feuilles Excel

Optimiser une macro de comparaison de feuilles Excel - VB/VBA/VBS - Programmation

Marsh Posté le 21-10-2011 à 15:51:33    

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 :
  1. Sub Comparaison()
  2.    
  3.     Dim nbLigneAIA As Long
  4.     Dim nbLigneCRI As Long
  5.    
  6.     ' ------------  Compteurs de boucles - - - - - - - - - - - -
  7.    
  8.     Dim i As Long
  9.     Dim j As Long
  10.     Dim nbCol As Integer
  11.    
  12.     Dim e_AIA As Long
  13.     Dim e_CRI As Long
  14.    
  15.     ' ------------  Booléens - - - - - - - - - - - -
  16.     Dim Y As Boolean
  18.    
  19.    
  20.     Dim WbA As Workbook, WbN As Workbook
  21.     Dim WsA As Worksheet, WsN As Worksheet
  23.     ' ------------  Initialisation Workbook et Sheets - - - - - - - - - - - -
  24.     Set WbA = Workbooks("Automatisation_RQT_V3.xlsm" )
  25.     Set WbN = Workbooks("Automatisation_RQT_V3.xlsm" )
  26.     Set WbData = Workbooks("Automatisation_RQT_V3.xlsm" )
  27.     Set WsA = WbA.Worksheets("Req_AIA" )
  28.     Set WsN = WbN.Worksheets("Req_CRI" )
  30.     ' ------------  Détermination des tailles des 2 fichiers - - - - - - - - - - - -
  31.     With Sheets("Req_AIA" )
  32.         nbLigneAIA = .Range("B" & .Rows.Count).End(xlUp).Row
  33.     End With
  35.     With Sheets("Req_CRI" )
  36.         nbLigneCRI = .Range("B" & .Rows.Count).End(xlUp).Row
  37.     End With
  38.  
  39.    'L 'utilisateur choisit le nombre de colonnes à comparer
  40.    nbCol = Workbooks("Automatisation_RQT_V3.xlsm" ).Sheets("Donnees" ).Range("B1" ).Value + 1
  41.  
  42.    ' ------------  Tableaux - - - - - - - - - - - -
  43.     Dim TabloAIA() As Variant
  44.     Dim TabloCRI() As Variant
  46.    ' Initialisation des booléens
  47.     Y = False
  49.    TabloAIA() = WsA.Range("B2:Q" & nbLigneAIA)
  50.    TabloCRI() = WsN.Range("B2:Q" & nbLigneCRI)
  51.    'TabloAIA() = WsA.Range(Cells(1, 1), Cells(nbLigneAIA, nbCol + 1))
  52.    'TabloCRI() = WsN.Range(Cells(1, 1), Cells(nbLigneCRI, nbCol + 1))
  53.    'Détermination des absents
  54.     For i = 2 To nbLigneAIA
  55.         Y = False
  56.         For j = 2 To nbLigneCRI
  57.            
  58.             ' Tester si la ligne n'a pas déjà été trouvée avant
  59.             'If WsN.Cells(j, nbCol + 1) <> "Trouvé" Then
  60.             If TabloCRI(j - 1, nbCol) <> "Trouvé" Then
  61.                 If TabloAIA(i - 1, 1) = TabloCRI(j - 1, 1) Then
  62.                     'Si égalité alors on pose un drapeau
  63.                     Y = True
  64.                     WsA.Cells(i, 2).Interior.ColorIndex = 4
  65.                    
  66.                     'et on vérifie la ligne si c'est une égalité stricte
  67.                     For k = 3 To nbCol
  68.                         ' Si égalité alors on colorie la cellule en vert
  69.                         'If WsA.Cells(i, k) = WsN.Cells(j, k) Then
  70.                         If TabloAIA(i - 1, k - 1) = TabloCRI(j - 1, k - 1) Then
  71.                             WsA.Cells(i, k).Interior.ColorIndex = 4
  72.            
  73.                         Else
  74.                         '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)
  75.                
  76.                             If WsA.Cells(i, k).Interior.ColorIndex <> 4 Then
  77.                             'Ys = True
  78.                             'et on colore en orange
  79.                             WsA.Cells(i, k).Interior.ColorIndex = 45
  80.                             Y = False
  81.                             Exit For
  82.                         End If
  83.                    
  84.                 End If
  85.            
  86.            Next
  87.         End If
  88.              'Si on trouve la ligne on sort immédiatement du 2 ieme For (éviter de parcours le reste pour rien)
  89.             If Y Then Exit For
  90.             End If
  91.          
  92.         Next
  93.      
  94.        
  95.         If Y = True Then
  96.         'Marquer dans le fichier CRI les lignes trouvées pour éviter de laisser passer les doublons
  97.             'WsN.Cells(j, nbCol + 1) = "Trouvé"
  98.             TabloCRI(j - 1, nbCol) = "Trouvé"
  99.         Else
  100.         'Si pas trouvé alors on colorie la ligne AIA en rouge
  101.             WsA.Range("B" & i).Interior.ColorIndex = 3
  102.             'WsA.Cells(i, nbCol + 1) = "Non Trouvé"
  103.             TabloAIA(i - 1, nbCol) = "Non Trouvé"
  104.         End If
  105.         Y = False
  106.    Next
  108.     'MAJ des états dans les feuilles
  109.     For e_AIA = 1 To nbLigneAIA - 1
  110.         WsA.Cells(e_AIA + 1, nbCol + 1) = TabloAIA(e_AIA, nbCol)
  111.     Next
  112.     For e_CRI = 1 To nbLigneCRI - 1
  113.         WsN.Cells(e_CRI + 1, nbCol + 1) = TabloCRI(e_CRI, nbCol)
  114.     Next
  115.    
  116.    
  117.    Erase TabloAIA
  118.    Erase TabloCRI
  119.    Set WbA = Nothing
  120.    Set WbN = Nothing
  121.    Set WsA = Nothing
  122.    Set WsN = Nothing
  124.    End Sub

Reply

Marsh Posté le 21-10-2011 à 15:51:33   

Reply

Marsh Posté le 21-10-2011 à 17:16:54    

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 ...
Reply

Marsh Posté le 12-11-2011 à 17:16:31    

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


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

Marsh Posté le 12-11-2011 à 17:16:32    

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 :
  1. TabloAIA() = WsA.Range("B2:Q" & nbLigneAIA)
  2. TabloCRI() = WsN.Range("B2:Q" & nbLigneCRI)

Alors tu peux avantageusement remplacer les lignes 109 à 114 par

Code :
  1. WsA.Range("B2:Q" & nbLigneAIA) = TabloAIA()
  2. 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 :
  1. Application.ScreenUpdating = False


A+
 
 
 


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

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed