Vitesse d'exécution du code

**Naghoan** · 28/03/2018, 11h10

Bonjour,

J'ai créé un fichier qui permet d'établir chaque mois les avis d'échéance de toutes les personnes à qui nous louons un appartement.

Il est construit tel que :

- Le premier onglet "MODELE" est un avis d'échéance vierge qui sert de trame.
- Le deuxième onglet "SORTIE" est la même chose mais pour la sortie des locataires.
- Le troisième onglet "LISTE" est une base de données de tous les logements que nous avons avec les données des personnes qui l'occupent (le(s) nom(s)/prénom(s), l'adresse du logement, l'antenne qui s'en occupe -je travaille au siège-, la date d'entrée, éventuellement celle de sortie, le montant du loyer, des charges, et toutes les éventualités comme les régules de charges, les facturations de travaux suite aux dégradations, etc etc).
Chaque ligne dans la feuille correspond à une personne dans un logement.

Ensuite, en appuyant sur un bouton, Excel me crée pour chaque ligne affichée (en tenant compte donc des filtres), un onglet qui reprend la trame du modèle et en la complétant avec les données des personnes concernées.

Lorsque j'ai commencé à créer ce fichier, il était relativement rapide à la création des avis d'échéance (instantané en fait). Puis en le modifiant petit à petit, il a nettement perdu de sa rapidité ^^. Il faut dorénavant entre 2 et 5 secondes pour créer chaque feuille.

Voici le code que j'utilise pour la création des avis d'échéance :

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
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
Public Sub CreerFeuilles()
 
    Dim c As Object
    Dim CELLULE As Object
 
    'Efface "User :" dans les commentaires
    For Each c In ActiveSheet.Comments
        c.Text Text:=Replace(c.Text, Application.UserName & ":" & Chr(10), "")
    Next c
 
    'Copie les commentaires dans des cellules
    For Each c In Range("AK2:CE10000", [X65000].End(xlUp))
        If Not c.Comment Is Nothing Then
            c.Offset(0, 132) = c.Comment.Text
        End If
    Next c
 
    'Sub Créer Feuilles
    Dim oShModele As Worksheet
    Dim oShSortie As Worksheet
    Dim oShListe As Worksheet
    Dim oShMenus As Worksheet
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim oShNew As Worksheet
    Dim sNomOnglet As String
 
    Set oShModele = Worksheets("MODELE")
    Set oShSortie = Worksheets("SORTIE")
    Set oShListe = Worksheets("LISTE")
    Set oShMenus = Worksheets("MENUS")
 
    iLigFin = oShListe.Range("E" & Rows.Count).End(xlUp).Row
 
    For iLig = 2 To iLigFin
 
    If oShListe.Range("E" & iLig).Rows.Hidden = False Then
 
        If oShListe.Range("E" & iLig).Value <> "" Then
            sNomOnglet = oShListe.Range("B" & iLig).Value & "-" & oShListe.Range("NA" & iLig).Value
            If OngletExist(sNomOnglet) Then
                Set oShNew = Worksheets(sNomOnglet)
            Else
                If oShListe.Range("DK" & iLig).Value = 1 Then
                    oShSortie.Copy After:=Worksheets(Worksheets.Count)
                    Worksheets(Worksheets.Count).Name = sNomOnglet
                    Set oShNew = Worksheets(Worksheets.Count)
 
                    oShNew.Range("L5").Value = oShListe.Range("N" & iLig).Value 'Date de sortie
 
                Else
                    oShModele.Copy After:=Worksheets(Worksheets.Count)
                    Worksheets(Worksheets.Count).Name = sNomOnglet
                    Set oShNew = Worksheets(Worksheets.Count)  
 
                End If
 
            End If
 
            oShNew.Range("K1").Value = oShListe.Range("C" & iLig).Value 'Dispositif
            oShNew.Range("J15").Value = oShListe.Range("D" & iLig).Value 'Antenne
            oShNew.Range("K8").Value = oShListe.Range("E" & iLig).Value 'Nom
            If oShListe.Range("F" & iLig).Value <> "" Then
                oShNew.Range("K9").Value = oShListe.Range("F" & iLig).Value 'Nom 2
            End If
            If oShListe.Range("G" & iLig).Value <> "" Then
                oShNew.Range("I11").Value = oShListe.Range("G" & iLig).Value 'Adresse
            End If
                oShNew.Range("I12").Value = oShListe.Range("H" & iLig).Value 'Adresse 2
            oShNew.Range("I13").Value = oShListe.Range("I" & iLig).Value 'Adresse 3
            If oShListe.Range("J" & iLig).Value <> "" Then
                oShNew.Range("L3").Value = oShListe.Range("J" & iLig).Value 'Réf. CAF
            End If
            oShNew.Range("L4").Value = oShListe.Range("K" & iLig).Value 'Date d'entrée
            If oShListe.Range("N" & iLig).Value <> "" Then
                oShNew.Range("I5").Value = "Sortie réelle :"
            oShNew.Range("L5").Value = oShListe.Range("N" & iLig).Value 'Date de sortie
            End If
            oShNew.Range("L15").Value = oShListe.Range("M" & iLig).Value 'Date de facture
            If oShListe.Range("O" & iLig).Value <> "" Then
                oShNew.Range("A19").Value = oShListe.Range("O" & iLig).Value 'Message 1
            End If
            If oShListe.Range("P" & iLig).Value <> "" Then
                oShNew.Range("A20").Value = oShListe.Range("P" & iLig).Value 'Message 2
            End If
            If oShListe.Range("Q" & iLig).Value <> "" Then
                oShNew.Range("A21").Value = oShListe.Range("Q" & iLig).Value 'Message 3
            End If
            If oShListe.Range("BS" & iLig).Value <> "" Then
                oShNew.Range("E27").Value = oShListe.Range("BS" & iLig).Value 'Solde au 31/12
            End If
            oShNew.Range("K23").Value = oShListe.Range("DM" & iLig).Value 'Mois
 
            'Mois en cours
            oShNew.Range("L30").Value = oShListe.Range("ES" & iLig).Value 'Loyer
            If oShListe.Range("IH" & iLig).Value <> "" Then
                oShNew.Range("L32").Value = oShListe.Range("IH" & iLig).Value 'Valeur 2
            oShNew.Range("H32").Value = oShListe.Range("II" & iLig).Value 'Intitulé 2
            End If
            If oShListe.Range("IJ" & iLig).Value <> "" Then
                oShNew.Range("L34").Value = oShListe.Range("IJ" & iLig).Value 'Valeur 3
                oShNew.Range("H34").Value = oShListe.Range("IK" & iLig).Value 'Intitulé 3
            End If
            If oShListe.Range("IL" & iLig).Value <> "" Then
                oShNew.Range("L36").Value = oShListe.Range("IL" & iLig).Value 'Valeur 4
                oShNew.Range("H36").Value = oShListe.Range("IM" & iLig).Value 'Intitulé 4
            End If
            If oShListe.Range("IN" & iLig).Value <> "" Then
                oShNew.Range("L38").Value = oShListe.Range("IN" & iLig).Value 'Valeur 5
                oShNew.Range("H38").Value = oShListe.Range("IO" & iLig).Value 'Intitulé 5
            End If
            If oShListe.Range("IP" & iLig).Value <> "" Then
                oShNew.Range("L40").Value = oShListe.Range("IP" & iLig).Value 'Valeur 6
                oShNew.Range("H40").Value = oShListe.Range("IQ" & iLig).Value 'Intitulé 6
            End If
            If oShListe.Range("IR" & iLig).Value <> "" Then
                oShNew.Range("L42").Value = oShListe.Range("IR" & iLig).Value 'Valeur 7
                oShNew.Range("H42").Value = oShListe.Range("ID" & iLig).Value 'Intitulé 7
            End If
            If oShListe.Range("IT" & iLig).Value <> "" Then
                oShNew.Range("L44").Value = oShListe.Range("IT" & iLig).Value 'Valeur 8
                oShNew.Range("H44").Value = oShListe.Range("IU" & iLig).Value 'Intitulé 8
            End If
 
            'Récapitulatif des loyers
            If oShListe.Range("FB" & iLig).Value <> 0 Then
                oShNew.Range("E28").Value = oShListe.Range("FB" & iLig).Value '1
            End If
            If oShListe.Range("FC" & iLig).Value <> 0 Then
                oShNew.Range("E34").Value = oShListe.Range("FC" & iLig).Value '2
            End If
            If oShListe.Range("FD" & iLig).Value <> 0 Then
                oShNew.Range("E38").Value = oShListe.Range("FD" & iLig).Value '3
            End If
            If oShListe.Range("FE" & iLig).Value <> 0 Then
                oShNew.Range("E42").Value = oShListe.Range("FE" & iLig).Value '4
            End If
            If oShListe.Range("FF" & iLig).Value <> 0 Then
                oShNew.Range("E46").Value = oShListe.Range("FF" & iLig).Value '5
            End If
            If oShListe.Range("FG" & iLig).Value <> 0 Then
                oShNew.Range("E50").Value = oShListe.Range("FG" & iLig).Value '6
            End If
            If oShListe.Range("FH" & iLig).Value <> 0 Then
                oShNew.Range("E54").Value = oShListe.Range("FH" & iLig).Value '7
            End If
            If oShListe.Range("FI" & iLig).Value <> 0 Then
                oShNew.Range("E58").Value = oShListe.Range("FI" & iLig).Value '8
            End If
            If oShListe.Range("FJ" & iLig).Value <> 0 Then
                oShNew.Range("E62").Value = oShListe.Range("FJ" & iLig).Value '9
            End If
            If oShListe.Range("FK" & iLig).Value <> 0 Then
                oShNew.Range("E66").Value = oShListe.Range("FK" & iLig).Value '10
            End If
            If oShListe.Range("FL" & iLig).Value <> 0 Then
                oShNew.Range("E70").Value = oShListe.Range("FL" & iLig).Value '11
            End If
 
            'Récapitulatif des versements
            If oShListe.Range("FW" & iLig).Value <> 0 Then
                oShNew.Range("E32").Value = oShListe.Range("FW" & iLig).Value '1
            End If
            If oShListe.Range("FX" & iLig).Value <> 0 Then
                oShNew.Range("E36").Value = oShListe.Range("FX" & iLig).Value '2
            End If
            If oShListe.Range("FY" & iLig).Value <> 0 Then
                oShNew.Range("E40").Value = oShListe.Range("FY" & iLig).Value '3
            End If
            If oShListe.Range("FZ" & iLig).Value <> 0 Then
                oShNew.Range("E44").Value = oShListe.Range("FZ" & iLig).Value '4
            End If
            If oShListe.Range("GA" & iLig).Value <> 0 Then
                oShNew.Range("E48").Value = oShListe.Range("GA" & iLig).Value '5
            End If
            If oShListe.Range("GB" & iLig).Value <> 0 Then
                oShNew.Range("E52").Value = oShListe.Range("GB" & iLig).Value '6
            End If
            If oShListe.Range("GC" & iLig).Value <> 0 Then
                oShNew.Range("E56").Value = oShListe.Range("GC" & iLig).Value '7
            End If
            If oShListe.Range("GD" & iLig).Value <> 0 Then
                oShNew.Range("E60").Value = oShListe.Range("GD" & iLig).Value '8
            End If
            If oShListe.Range("GE" & iLig).Value <> 0 Then
                oShNew.Range("E64").Value = oShListe.Range("GE" & iLig).Value '9
            End If
            If oShListe.Range("GF" & iLig).Value <> 0 Then
                oShNew.Range("E68").Value = oShListe.Range("GF" & iLig).Value '10
            End If
            If oShListe.Range("GG" & iLig).Value <> 0 Then
                oShNew.Range("E72").Value = oShListe.Range("GG" & iLig).Value '11
            End If
 
            'Récapitulatif des versements CAF
            If oShListe.Range("GJ" & iLig).Value <> 0 Then
                oShNew.Range("E31").Value = oShListe.Range("GJ" & iLig).Value '1
            End If
            If oShListe.Range("GK" & iLig).Value <> 0 Then
                oShNew.Range("E35").Value = oShListe.Range("GK" & iLig).Value '2
            End If
            If oShListe.Range("GL" & iLig).Value <> 0 Then
                oShNew.Range("E39").Value = oShListe.Range("GL" & iLig).Value '3
            End If
            If oShListe.Range("GM" & iLig).Value <> 0 Then
                oShNew.Range("E43").Value = oShListe.Range("GM" & iLig).Value '4
            End If
            If oShListe.Range("GN" & iLig).Value <> 0 Then
                oShNew.Range("E47").Value = oShListe.Range("GN" & iLig).Value '5
            End If
            If oShListe.Range("GO" & iLig).Value <> 0 Then
                oShNew.Range("E51").Value = oShListe.Range("GO" & iLig).Value '6
            End If
            If oShListe.Range("GP" & iLig).Value <> 0 Then
                oShNew.Range("E55").Value = oShListe.Range("GP" & iLig).Value '7
            End If
            If oShListe.Range("GQ" & iLig).Value <> 0 Then
                oShNew.Range("E59").Value = oShListe.Range("GQ" & iLig).Value '8
            End If
            If oShListe.Range("GR" & iLig).Value <> 0 Then
                oShNew.Range("E63").Value = oShListe.Range("GR" & iLig).Value '9
            End If
            If oShListe.Range("GS" & iLig).Value <> 0 Then
                oShNew.Range("E67").Value = oShListe.Range("GS" & iLig).Value '10
            End If
            If oShListe.Range("GT" & iLig).Value <> 0 Then
                oShNew.Range("E71").Value = oShListe.Range("GT" & iLig).Value '11
            End If
 
            'Récapitulatif - Date des versements
            If oShListe.Range("HJ" & iLig).Value <> "" Then
                oShNew.Range("F32").Value = oShListe.Range("HJ" & iLig).Value '1
            End If
            If oShListe.Range("HK" & iLig).Value <> "" Then
                oShNew.Range("F36").Value = oShListe.Range("HK" & iLig).Value '2
            End If
            If oShListe.Range("HL" & iLig).Value <> "" Then
                oShNew.Range("F40").Value = oShListe.Range("HL" & iLig).Value '3
            End If
            If oShListe.Range("HM" & iLig).Value <> "" Then
                oShNew.Range("F44").Value = oShListe.Range("HM" & iLig).Value '4
            End If
            If oShListe.Range("HN" & iLig).Value <> "" Then
                oShNew.Range("F48").Value = oShListe.Range("HN" & iLig).Value '5
            End If
            If oShListe.Range("HO" & iLig).Value <> "" Then
                oShNew.Range("F52").Value = oShListe.Range("HO" & iLig).Value '6
            End If
            If oShListe.Range("HP" & iLig).Value <> "" Then
                oShNew.Range("F56").Value = oShListe.Range("HP" & iLig).Value '7
            End If
            If oShListe.Range("HQ" & iLig).Value <> "" Then
                oShNew.Range("F60").Value = oShListe.Range("HQ" & iLig).Value '8
            End If
            If oShListe.Range("HR" & iLig).Value <> "" Then
                oShNew.Range("F64").Value = oShListe.Range("HR" & iLig).Value '9
            End If
            If oShListe.Range("HS" & iLig).Value <> "" Then
                oShNew.Range("F68").Value = oShListe.Range("HS" & iLig).Value '10
            End If
            If oShListe.Range("HT" & iLig).Value <> "" Then
                oShNew.Range("F72").Value = oShListe.Range("HT" & iLig).Value '11
            End If
 
            'Récapitulatif des régules
            If oShListe.Range("IW" & iLig).Value <> 0 Then
                oShNew.Range("E33").Value = oShListe.Range("IW" & iLig).Value '1
            End If
            If oShListe.Range("IX" & iLig).Value <> 0 Then
                oShNew.Range("E37").Value = oShListe.Range("IX" & iLig).Value '2
            End If
            If oShListe.Range("IY" & iLig).Value <> 0 Then
                oShNew.Range("E41").Value = oShListe.Range("IY" & iLig).Value '3
            End If
            If oShListe.Range("IZ" & iLig).Value <> 0 Then
                oShNew.Range("E45").Value = oShListe.Range("IZ" & iLig).Value '4
            End If
            If oShListe.Range("JA" & iLig).Value <> 0 Then
                oShNew.Range("E49").Value = oShListe.Range("JA" & iLig).Value '5
            End If
            If oShListe.Range("JB" & iLig).Value <> 0 Then
                oShNew.Range("E53").Value = oShListe.Range("JB" & iLig).Value '6
            End If
            If oShListe.Range("JC" & iLig).Value <> 0 Then
                oShNew.Range("E57").Value = oShListe.Range("JC" & iLig).Value '7
            End If
            If oShListe.Range("JD" & iLig).Value <> 0 Then
                oShNew.Range("E61").Value = oShListe.Range("JD" & iLig).Value '8
            End If
            If oShListe.Range("JE" & iLig).Value <> 0 Then
                oShNew.Range("E65").Value = oShListe.Range("JE" & iLig).Value '9
            End If
            If oShListe.Range("JF" & iLig).Value <> 0 Then
                oShNew.Range("E69").Value = oShListe.Range("JF" & iLig).Value '8
            End If
            If oShListe.Range("JG" & iLig).Value <> 0 Then
                oShNew.Range("E73").Value = oShListe.Range("JG" & iLig).Value '8
            End If
 
            If oShListe.Range("MX" & iLig).Value <> 0 Then
                oShNew.Range("E29").Value = oShListe.Range("MX" & iLig).Value 'Récap Caution
            End If
            If oShListe.Range("MY" & iLig).Value <> 0 Then
                oShNew.Range("E30").Value = oShListe.Range("MY" & iLig).Value 'Récap FSL
            End If
 
 
            'lien hypertext
            oShNew.Hyperlinks.Add Anchor:=oShListe.Range("E" & iLig), Address:="", SubAddress:= _
                    "'" & sNomOnglet & "'!A1", TextToDisplay:=oShListe.Range("E" & iLig).Value
            Set oShNew = Nothing
        End If
 
    End If
 
    Next iLig
 
    oShListe.Select
 
    Set oShListe = Nothing
    Set oShModele = Nothing
    Set oShSortie = Nothing
    Set oShMenus = Nothing
 
End Sub

Je précise qu'il y a sans doute un paquet de choses "bizarres", je ne fais que du bidouillage à partir de ce que je trouve sur Internet. A vrai dire, j'ai même découvert l'existence du VBA en créant ce fichier.

Il y aurait-il, justement dans mes bidouillages, un moyen pour que l'éxecution du code soit plus rapide ? Par exemple des raccourcis à ce que j'ai pu écrire ? Ou est-ce qu'il y a des commandes que j'ai utilisé qui pourraient être la cause du ralentissement ?

Merci