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