Comparaison de feuilles Excel VBA

[Soft77]

Bonjour,

J'utilise le code de Galopin pour comparer 2 feuilles Excel.
Le problème étant que chaque feuille peut atteindre 350 000 lignes et donc la macro est très très lente (25 min environ) ou bien ne tourne pas et je ne sais vraiment pas pourquoi

Je voulais savoir si quelqu'un pouvait m'aider à optimiser le code: SVP à l'aide

Contexte:

Comparaison de 2 fichiers txt que j'importe manuellement sur Excel.
Ces fichiers ne sont pas ordonnés à l'identique mais possèdent exctement la même structure en colonnes et doivent contenir strictement les mêmes lignes.

Objectif:

Détecter les lignes, du premier fichier txt importé, qui sont absentes dans le second.

La macro semble bien tourner sur un certain nombre de lignes mais le problème est que les fichiers peuvent aller jusqu'à 350 000 lignes!!!

PS: Je suis débutant en VBA
Merci d'avance et si pas de réponse je remercie encore une fois Galopin ainsi que tous ceux qui partagent leurs codes.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
 
Sub Comparaison()
    Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
    Dim nbLigneAIA As Long
    Dim nbLigneCRI As Long
 
    ' ------------  Compteurs de boucles - - - - - - - - - - - -
 
    Dim i As Long
    Dim j As Long
    Dim nbCol As Integer
 
    ' ------------  Booléens - - - - - - - - - - - -
    Dim Y As Boolean
   'Dim Ys As Boolean
 
 
    'Dim TabloA(), TabloN()
 
 
    Dim WbA As Workbook, WbN As Workbook
    Dim WsA As Worksheet, WsN As Worksheet
 
 
    Set WbA = Workbooks("Automatisation_RQT.xlsm")
    Set WbN = Workbooks("Automatisation_RQT.xlsm")
    Set WbData = Workbooks("Automatisation_RQT.xlsm")
    Set WsA = WbA.Worksheets("Req_AIA")
    Set WsN = WbN.Worksheets("Req_CRI")
 
  'Détermination du nombre de ligne de Classeur "AIA" et "CRI"
  ' ILRA = WsA.Cells(65535, 1).End(xlUp).Row / Ne marche pas pour un fichier dépassant la taille max (ex: Excel 2007)
  ' ILRB = WsN.Cells(65535, 1).End(xlUp).Row / Ne marche pas pour un fichier dépassant la taille max (ex: Excel 2007)
 
    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.xlsm").Sheets("Donnees").Range("B1").Value + 1
 
   ' Initialisation des booléens
    Y = False
   'Ys = False
 
    'Accélérateur de Macro
    'Call ini_sub
 
    'Appel à la fonction de Tri
    'Call Tri_criteres
 
    'Appel à la fonction de suppression des blancs
    'Call SupprEspaces
 
   'Détermination des absents
    For i = 2 To nbLigneAIA
    'If IsEmpty(WsA.Cells(i, 1).Value) Then GoTo AIA
        Y = False
        For j = 2 To nbLigneCRI
        'If IsEmpty(WsN.Cells(j, 1).Value) And j > ILRB Then GoTo CRI
 
            If WsA.Cells(i, 2) = WsN.Cells(j, 2) 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
                       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
             'sinon 1ere cellule en vert
             'WsN.Cells(j, 1).Interior.ColorIndex = IIf(Ys, 45, 4)
             'WsA.Cells(i, 1).Interior.ColorIndex = IIf(Ys, 45, 4)
             'Ys = False
 
             '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
 
       ' On supprime la ligne trouvée dans les CRI avant de sortir du 2 ieme For (pour minimiser la taille de recherche)
       ' Et on décrémente la taille du fichier CRI
        If Y = True Then
            WsN.Cells(j, 1).EntireRow.Delete
            nbLigneCRI = nbLigneCRI - 1
        Else
            'Si pas trouvé alors on colorie en rouge
            WsA.Range("B" & i).Interior.ColorIndex = 3
        End If
        Y = False
   Next
 
'AIA: MsgBox ("L'Onglet AIA est FINI")
'GoTo FIN
'CRI: MsgBox ("L'Onglet CRI est VIDE ou TERMINE ---> Fin de recherche!!!")
   MsgBox ("FIN DE TRAITEMENT")
   Set WbA = Nothing
   Set WbN = Nothing
   Set WsA = Nothing
   Set WsN = Nothing
 
   'Call fin_sub
   End Sub

[issoram]

Bonjour

Travailler avec des tableaux plutôt qu'avec des cellules améliorera nettement la performance de ton code.
Je te renvoie à l'introduction de cet excellent tutoriel sur la manipulation des tableaux en VBA.

Citation extraite de ce document:

Passer par un tableau n'est pas une obligation. Toutefois, cette méthode permet des gains de temps significatifs, notamment pour la manipulation des grands groupes de données. Sur les grandes collections, il convient d'éviter l'énumération qui est très lente.

Cordialement.

[Theze]

Bonsoir,

Effectivement, le travail sur des tableaux est beaucoup plus rapide. Il faut voir pour les couleurs et les suppressions de lignes (peut être deux autres tableaux avec mémorisation des positions des lignes à supprimer et mémorisation des couleurs à appliquer). Un début de code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Dim Tbl_AIA
Dim Tbl_CRI
 
With Worksheets("Req_AIA")
 
    'à partir de B2
    Tbl_AIA = .Range(.Cells(2, 2), _
                     .Cells(.Cells.Find("*", .[A1], -4123, , _
                     1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                     2, 2).Column))
 
End With
 
With Worksheets("Req_CRI")
 
    Tbl_CRI = .Range(.Cells(2, 2), _
                     .Cells(.Cells.Find("*", .[A1], -4123, , _
                     1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                     2, 2).Column))
 
End With
 
For I = 1 To UBound(Tbl_AIA, 1) '1 = lignes, 2 = colonnes
 
    Y = False
 
    For J = 1 To UBound(Tbl_CRI, 1)
 
        If Tbl_AIA(I, 2) = Tbl_CRI(J, 2) Then
 
            Y = True
 
            'etc...!

Hervé.