Discussion :

[Pleyel]

Bonjour,

Je me permets de vous solliciter car je suis débutant en programmation VBA et je ne sais pas comment optimiser le code d'une macro que j'ai "bricolé" pour mon travail.

En effet, je dois comparer 2 fichiers entre eux et mettre à jour l'un des fichiers par rapport à l'autre. Le premier fichier est le fichier de référence qui contient les informations de référence à jour. Le deuxième fichier est un fichier de travail, qui permet de suivre d'autres informations liées aux données de référence du premier fichier.

J'ai donc réalisé (comme j'ai pu) une macro qui va, à l'ouverture du fichier de travail, réaliser les actions suivantes :

- Recherche les lignes qui n'existe plus dans le fichier de référence et les colorent en rouge (la comparaison se fait par rapport à la colonne 3 et 4 des fichiers ci-joint)

- Met à jour les données de référence pour les lignes qui sont présentes dans les 2 fichiers (pour éviter que la modification d'une information contenue dans une colonne non testée du fichier de référence ne soit pas mise à jour dans le fichier de travail)

- Recherche les lignes qui ont été rajoutées dans le fichier de référence, copie ces lignes, les rajoutent dans le fichier de travail et les colorent en vert.

- Affiche un message qui indique le nombre de lignes qui ont été supprimées et le nombre de lignes qui ont été ajoutées.

Cette macro fonctionne mais le problème c'est qu'elle prend beaucoup trop de temps à s'exécuter (elle doit s'exécuter à chaque ouverture du fichier de travail!!).

Étant novice en VBA j'ai très probablement du alourdir inutilement ma macro, pourriez vous m'aider à optimiser cette macro pour qu'elle puisse s'exécuter dans un temps qui reste raisonnable ? (de l'ordre de 10 secondes)

Vous trouverez ci-joint les 2 fichiers citées plus haut : le fichier de référence "Copie de Liste alphabétique des sites vtest1.xls" et le fichier de travail "Listes installations test1.xls". Le nombre de ligne du fichier de référence à été volontairement tronqué pour une question de taille. Du coup, le délai d'exécution de la macro paraît correct alors qu'en réalité lorsque le fichier contient le nombre de lignes réel (environ 1700 lignes), le délai est beaucoup plus long!!

Merci d'avance pour l'aide que vous pourrez m'apporter.
C
ordialement,

PS : pour la bonne exécution de la macro, il faut modifier le chemin du fichier de référence " Chemin_fichier_réf =".

[gourmand]

pour gagner énormément de temps au lieu de faire cellule par cellule, tu peux faire la plage de cellule d'un coup, la stocké dans un tableau et travailler avec ce tableau (car se qui prend le plus de temps c'est la lecture et l'écriture sur une cellule et il est le même pour une seul cellule ou plage de cellule)

[Pleyel]

Bonjour Gourmand, peux tu préciser un peu plus ta réponse car je n'ai pas vraiment compris...

Merci d'avance

[gourmand]

deux fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
for i=1 to 10000
variable = cells(i,1).value
... tout le programme
 cells(i,1).value = variable 2
next i

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
variableT = range("A1:A10000").value
for i=1 to 10000
... tout le programme
next i
 
range("A1:A10000").value = variableT

dans le premier tu fais cellule par cellule.
dans le second, tu prend toute tes cellule est tu travail avec un tableau.

alors que le premier cas peux te prendre 15 min, le second cas ne te prendra que 1 seconde

c'est se que j'ai fais car ma macro prenais et sa marche, je suis vraiment passé de 15 min a 1 sec

[Pleyel]

Bonjour Gourmand,

Je n'arrive pas à appliquer tes conseils à ma macro, pourrais me donner un coup de main ?

Merci d'avance.

[gourmand]

a tu un bout de code a me montré ?

[Pleyel]

Oui tu trouveras les deux fichiers excel en pièce jointe dans mon premier message.

Sinon voici le code complet :

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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
Sub Maj_installations_totale_filtre_à_définir_v2()
 
'Désactive la vision à l'écran des différentes étapes de la macro
 
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
 
'Ouvre le fichier avec la liste d'installations de référence
 
    Chemin_fichier_réf = "C:\Documents and Settings\TQ1176\Desktop\A traiter\Maj installations\Copie de Liste alphabétique des sites vtest.xls"
 
    Workbooks.Open Filename:=Chemin_fichier_réf
 
'Initialisation des variable
 
    t = Timer()
 
    Nom_fichier_ref = "Copie de Liste alphabétique des sites vtest.xls"
 
    Nom_fichier_maj = "Listes installations test.xls"
 
    Nom_onglet_ref = "Liste installations"
 
    Nom_onglet_maj = "Liste installations"
 
    Prem_ligne_ref = 3
 
    Prem_ligne_maj = 3
 
    Colonne_installation_ref = 3
 
    Colonne_nomInstallation_ref = 4
 
    Colonne_installation_maj = 3
 
    Colonne_nomInstallation_maj = 4
 
    i = 0
 
    j = 0
 
    Compteur = 0
 
    Compteur_perdues = 0
 
    Compteur_nouvelles = 0
 
    ' on définit les filtres
 
    Colonne_filtre = 7
 
    Nom_filtre = "Z20 - QUEVA"
 
    'Recherche la dernière ligne de la liste d'installations à mettre à jour
 
    Workbooks(Nom_fichier_maj).Activate
 
    Dern_ligne_maj = Range("C65536").End(xlUp).Row
 
    'Recherche la dernière ligne de la liste d'installations de référence
 
    Workbooks(Nom_fichier_ref).Activate
 
    Dern_ligne_ref = Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Range("C65536").End(xlUp).Row
 
    ' Boucle identification installations perdues
 
    For X = Prem_ligne_maj To Dern_ligne_maj
 
    Application.StatusBar = "Identification des installations perdues et mise à jour des données : " & Int(100 * X / Dern_ligne_maj) & " %"
 
        'Filtre
 
'        If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(X, Colonne_filtre).Value = Nom_filtre Then
 
                For Y = Prem_ligne_ref To Dern_ligne_ref
 
                    'filtre
 
                    If Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(Y, Colonne_filtre).Value = Nom_filtre Then
 
                        'Comparaison des 2 fichiers par rapport au n° d'installation
 
                        If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(X, Colonne_installation_maj).Value = _
                        Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(Y, Colonne_installation_ref).Value Then
 
                        'Comparaison de contrôle par rapport au nom de l'installation
 
                            If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(X, Colonne_nomInstallation_maj).Value = _
                            Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(Y, Colonne_nomInstallation_ref).Value Then
 
                            Compteur = i + 1
 
                            ' MaJ de toutes les informations pour les installations présentes dans les 2 fichiers
 
                            With Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref)
                                .Range(.Cells(Y, 1), .Cells(Y, 27)).Copy
                            End With
                            With Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj)
                                .Range(.Cells(X, 1), .Cells(X, 27)).PasteSpecial Paste:=xlPasteValues, _
                                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            End With
 
'                            Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Activate
'                            Range(Cells(Y, 1), Cells(Y, 27)).Copy
'                            Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Activate
'                            Range(Cells(X, 1), Cells(X, 27)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'                            :=False, Transpose:=False
 
                            End If
 
                        Else
 
                        End If
 
                    End If
 
                Next Y
 
            If Compteur = 0 Then
 
                If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Rows(X).Interior.ColorIndex <> 3 Then
 
                Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Rows(X).Interior.ColorIndex = 46
 
                'Compte les installations supprimées depuis la dernière ouverture du fichier
 
                Compteur_perdues = Compteur_perdues + 1
 
                End If
 
            Else
 
            Compteur = 0
 
            End If
 
'        End If
 
    Next X
 
    ' Boucle rajout et indentification installations nouvelles
 
    i = 0
 
    For X = Prem_ligne_ref To Dern_ligne_ref
 
    Application.StatusBar = "Identification et ajout des nouvelles installations : " & Int(100 * X / Dern_ligne_ref) & " %"
 
        'Filtre
 
        If Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(X, Colonne_filtre).Value = Nom_filtre Then
 
                For Y = Prem_ligne_maj To Dern_ligne_maj
 
                    'Filtre
 
'                    If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(Y, Colonne_filtre).Value = Nom_filtre Then
 
                        'Comparaison des 2 fichiers par rapport au n° d'installation
 
                        If Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(X, Colonne_installation_ref).Value = _
                        Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(Y, Colonne_installation_maj).Value Then
 
                            'Comparaison de contrôle par rapport au nom de l'installation
 
                            If Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(X, Colonne_nomInstallation_ref).Value = _
                            Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(Y, Colonne_nomInstallation_maj).Value Then
 
                            Compteur = i + 1
 
                            'Compteur = 1 si l'installation est présente dans les 2 fichiers et 0 sinon
 
                            End If
 
                        Else
 
                        End If
 
'                    End If
 
                Next Y
 
            'La nouvelle installation est copiée dans le fichier à mettre à jour
 
            If Compteur = 0 Then
 
            Dern_ligne_maj = Dern_ligne_maj + 1
            With Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref)
               .Range(.Cells(X, 1), .Cells(X, 27)).Copy
            End With
 
'            Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Activate
'            Range(Cells(X, 1), Cells(X, 27)).Copy
            With Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj)    '.Activate
               .Range(.Cells(Dern_ligne_maj, 1), .Cells(Dern_ligne_maj, 27)).PasteSpecial _
                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End With
'            Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Activate
'            Range(Cells(Dern_ligne_maj, 1), Cells(Dern_ligne_maj, 27)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'            :=False, Transpose:=False
 
            'Colore en vert la dernière ligne ajouté
 
            Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Rows(Dern_ligne_maj).Interior.ColorIndex = 43
 
            'Compte les installations nouvelles depuis la dernière ouverture du fichier
 
            Compteur_nouvelles = Compteur_nouvelles + 1
 
            Else
 
            Compteur = 0
 
            End If
 
        End If
 
    Next X
 
'Fermeture du fichier avec les installations de référence
 
Workbooks(Nom_fichier_ref).Close
 
' Message pour indiquer le nombre d'installations nouvelles et le nombre d'installations supprimées
 
Application.ScreenUpdating = True
 
Application.StatusBar = False
 
MsgBox ("Il y a " & Compteur_nouvelles & " installation(s) nouvelle(s) et " & Compteur_perdues & " installation(s) supprimée(s) depuis votre dernière visite.")
 
'MsgBox ("Temps d'éxécution : " & Timer() - t & " secondes")
 
MsgBox Timer() - t
 
End Sub

[gourmand]

Voici deux codes que tu peux tester

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
Sub essai1()
 
For i = 1 To 10000
    ActiveWorkbook.ActiveSheet.Range("A" & i).Value = 1
Next i
MsgBox " --- terminé --- "
End Sub
 
Sub essai2()
Dim tableau
tableau = ActiveWorkbook.ActiveSheet.Range("A1:A10000").Value
For i = 1 To 10000
    tableau(i, 1) = 1
Next i
ActiveWorkbook.ActiveSheet.Range("A1:A10000").Value = tableau
MsgBox " --- terminé --- "
End Sub

Plus tu devras boucler, plus l'exécution de Essai1 sera longue, alors que la durée d'exécution de Essai2 variera à peine.

un exemple :
la condition :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
If Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(X, Colonne_nomInstallation_ref).Value = _
Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(Y, Colonne_nomInstallation_maj).Value Then

sera remplacé par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if tableau1( Colonne_nomInstallation_ref,X)=tableau2(Colonne_nomInstallation_maj,Y) then

plus besoin de lire dans une cellule

[Pleyel]

J'ai fait le test avec tes deux programmes (essai 1 et 2) et c'est vrai que c'est impressionnant!

J'ai essayé de le mettre dans ma boucle d'identification des installations perdues, mais lorsque je lance la macro j'obtiens l'erreur "l'indice n'appartient pas à la sélection" (voir ligne en rouge)...

Je ne sais pas comment procéder avec cette méthode!!!

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
' Boucle identification installations perdues
       
       'Dimensionnement des tableaux
    
        Dim tableau1
    
        tableau1 = Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Range("C" & Prem_ligne_maj & ": D" & Dern_ligne_maj).Value
        
        Dim tableau2
    
        tableau2 = Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Range("C" & Prem_ligne_ref & ": D" & Dern_ligne_ref).Value
        
    For X = Prem_ligne_maj To Dern_ligne_maj
    
            'Filtre
            
'        If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(X, Colonne_filtre).Value = Nom_filtre Then

                For Y = Prem_ligne_ref To Dern_ligne_ref
                                       
                        'Comparaison des 2 fichiers par rapport au n° d'installation
                        
                        If tableau1(Colonne_nomInstallation_maj, X) = tableau2(Colonne_nomInstallation_ref, Y) Then
                        
'                        If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(X, Colonne_installation_maj).Value = _
'                        Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(Y, Colonne_installation_ref).Value Then
                        
                        'Comparaison de contrôle par rapport au nom de l'installation
                        
'                            If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(X, Colonne_nomInstallation_maj).Value = _
'                            Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(Y, Colonne_nomInstallation_ref).Value Then
                       
                            Compteur = i + 1
                            
                            ' MaJ de toutes les informations pour les installations présentes dans les 2 fichiers
                            
                            With Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref)
                                .Range(.Cells(Y, 1), .Cells(Y, 27)).Copy
                            End With
                            With Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj)
                                .Range(.Cells(X, 1), .Cells(X, 27)).PasteSpecial Paste:=xlPasteValues, _
                                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            End With
       
'                            Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Activate
'                            Range(Cells(Y, 1), Cells(Y, 27)).Copy
'                            Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Activate
'                            Range(Cells(X, 1), Cells(X, 27)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'                            :=False, Transpose:=False
                            
                            'End If
                        
                        Else
                    
                        End If
                        
                    End If
                
                Next Y
            
            If Compteur = 0 Then
            
                If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Rows(X).Interior.ColorIndex <> 3 Then
                
                Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Rows(X).Interior.ColorIndex = 46
            
                'Compte les installations supprimées depuis la dernière ouverture du fichier
                
                Compteur_perdues = Compteur_perdues + 1
                
                End If
                
            Else
            
            Compteur = 0
            
            End If
    
'        End If
    
    Next X

[carden752]

Bonjour,

Il me semble que la colonne Colonne_nomInstallation_maj n'appartient pas à la sélection.
En effet, les tableaux ne comprennent que 2 colonnes C et D donc l'indice de colonne ne doit pas dépasser 2.

[Maxraw]

Bonjour, je sais qu'on est longtemps a^près mais ce post m'a beaucoup aidé, cependant, cette boucle laz ne s'exécute pas :

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
    For X = Prem_ligne_ref To Dern_ligne_ref
 
                For Y = Prem_ligne_maj To Dern_ligne_maj
 
                        'Comparaison des 2 fichiers par rapport au n° d'installation
 
                        If Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(X, Colonne_installation_ref).Value = _
                        Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(Y, Colonne_installation_maj).Value Then
 
                            'Comparaison de contrôle par rapport au nom de l'installation
                            If tableau1(Colonne_nomInstallation_ref, X) = tableau2(Colonne_nomInstallation_maj, Y) Then
 
                            Compteur = i + 1
 
                            'Compteur = 1 si l'installation est présente dans les 2 fichiers et 0 sinon
 
                            End If
 
                        Else
 
                        End If
 
                Next Y

L'indice n'appartient pas à la selection sur cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If tableau1(Colonne_nomInstallation_ref, X) = tableau2(Colonne_nomInstallation_maj, Y) Then

Mias l'indice des colonnes est bien à 2, je ne comprends pas du tout