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 : Sélectionner tout - Visualiser dans une fenêtre à part
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
Partager