Améliorer les performances générales de la macro

**Passepartout007** · 06/07/2018, 13h06

Bonjour,

J'ai une macro qui se lance afin d'incrémenter une listBox dans un userform, celle-ci fonctionne très bien. Mais suite à l'ajout de 5 000 ligne la macro fais ramé l'ordinateur. Qu'elle sont les possibilités permettant de diminuer le temps d'exécution d'une macro ?
voici le code :

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
Private Sub UserForm_Initialize()
Dim N As Integer
Dim I As Long
ListBox1.ColumnCount = 10 'nombre de colonnes la colonne 9 contient le numéro de ligne
ListBox1.ColumnWidths = "0;65;40;50;45;35;225;55;55;55" 'largeur des colonnes
ListBox1.TextAlign = fmTextAlignCenter ' centre le texte dans la listbox
ListBox2.ColumnCount = 10 'nombre de colonnes la colonne 9 contient le numéro de ligne
ListBox2.ColumnWidths = "0;65;40;50;45;35;225;55;55;55" 'largeur des colonnes
ListBox2.TextAlign = fmTextAlignCenter ' centre le texte dans la listbox
 
'trie par ordre alphabétique le N° FTS
 ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort.SortFields.Add _
        Key:=Range("E1:E1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
 Me.ListBox1.MultiSelect = fmMultiSelectSingle
 
'Filtre arrivé/départ 1
 
If RECHMOD.CheckBox1 = True Then
    Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=9, Criteria1:="<>"
    Selection.AutoFilter Field:=12, Criteria1:=""
 
 
 
    With Sheets("Base de données") 'dans la feuille Base de données
 
        If RECHMOD.CBoxUM.Value <> "" Then Selection.AutoFilter Field:=2, Criteria1:=RECHMOD.CBoxUM.Value
        If RECHMOD.CBoxType.Value <> "" Then Selection.AutoFilter Field:=3, Criteria1:=RECHMOD.CBoxType.Value
        If RECHMOD.CBoxMateriel.Value <> "" Then Selection.AutoFilter Field:=4, Criteria1:=RECHMOD.CBoxMateriel.Value
        If RECHMOD.CBoxNOrgane.Value <> "" Then Selection.AutoFilter Field:=5, Criteria1:=RECHMOD.CBoxNOrgane.Value
        If RECHMOD.CBoxTache.Value <> "" Then Selection.AutoFilter Field:=6, Criteria1:=RECHMOD.CBoxTache.Value
        If RECHMOD.CBoxVersion.Value <> "" Then Selection.AutoFilter Field:=7, Criteria1:=RECHMOD.CBoxVersion.Value
        If RECHMOD.CBoxDocValide.Value = "Oui" Then Selection.AutoFilter Field:=31, Criteria1:="<>"
 
        Derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'Défini la place de celulle et la derniere ligne d'une colonne
 
        For I = 2 To Derlig 'pour I de 1 à la dernière ligne
 
        'ajoute les données dans la listBox1
            If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
                    ListBox1.AddItem .Range("A" & I).Value
                    ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
                    ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
                    ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
                    ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
                    ListBox1.List(ListBox1.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
                    ListBox1.List(ListBox1.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
                    ListBox1.List(ListBox1.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
                    ListBox1.List(ListBox1.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
                    ListBox1.List(ListBox1.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
            End If
        Next I
        .ShowAllData
    End With 'fin du with
 
'Filtre arrivé/départ 2
 
    Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=13, Criteria1:="<>"
    Selection.AutoFilter Field:=16, Criteria1:=""
 
 
 
    With Sheets("Base de données") 'dans la feuille Base de données
 
        If RECHMOD.CBoxUM.Value <> "" Then Selection.AutoFilter Field:=2, Criteria1:=RECHMOD.CBoxUM.Value
        If RECHMOD.CBoxType.Value <> "" Then Selection.AutoFilter Field:=3, Criteria1:=RECHMOD.CBoxType.Value
        If RECHMOD.CBoxMateriel.Value <> "" Then Selection.AutoFilter Field:=4, Criteria1:=RECHMOD.CBoxMateriel.Value
        If RECHMOD.CBoxNOrgane.Value <> "" Then Selection.AutoFilter Field:=5, Criteria1:=RECHMOD.CBoxNOrgane.Value
        If RECHMOD.CBoxTache.Value <> "" Then Selection.AutoFilter Field:=6, Criteria1:=RECHMOD.CBoxTache.Value
        If RECHMOD.CBoxVersion.Value <> "" Then Selection.AutoFilter Field:=7, Criteria1:=RECHMOD.CBoxVersion.Value
        If RECHMOD.CBoxDocValide.Value = "Oui" Then Selection.AutoFilter Field:=31, Criteria1:="<>"
 
        Derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'Défini la place de celulle et la derniere ligne d'une colonne
        For I = 2 To Derlig 'pour I de 1 à la dernière ligne
 
        'ajoute les données dans la listBox1
            If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
                    ListBox1.AddItem .Range("A" & I).Value
                    ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
                    ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
                    ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
                    ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
                    ListBox1.List(ListBox1.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
                    ListBox1.List(ListBox1.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
                    ListBox1.List(ListBox1.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
                    ListBox1.List(ListBox1.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
                    ListBox1.List(ListBox1.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
            End If
        Next I
        .ShowAllData
    End With 'fin du with
 
'Filtre arrivé/départ 3
 
    Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=17, Criteria1:="<>"
    Selection.AutoFilter Field:=20, Criteria1:=""
 
 
 
    With Sheets("Base de données") 'dans la feuille Base de données
        If RECHMOD.CBoxUM.Value <> "" Then Selection.AutoFilter Field:=2, Criteria1:=RECHMOD.CBoxUM.Value
        If RECHMOD.CBoxType.Value <> "" Then Selection.AutoFilter Field:=3, Criteria1:=RECHMOD.CBoxType.Value
        If RECHMOD.CBoxMateriel.Value <> "" Then Selection.AutoFilter Field:=4, Criteria1:=RECHMOD.CBoxMateriel.Value
        If RECHMOD.CBoxNOrgane.Value <> "" Then Selection.AutoFilter Field:=5, Criteria1:=RECHMOD.CBoxNOrgane.Value
        If RECHMOD.CBoxTache.Value <> "" Then Selection.AutoFilter Field:=6, Criteria1:=RECHMOD.CBoxTache.Value
        If RECHMOD.CBoxVersion.Value <> "" Then Selection.AutoFilter Field:=7, Criteria1:=RECHMOD.CBoxVersion.Value
        If RECHMOD.CBoxDocValide.Value = "Oui" Then Selection.AutoFilter Field:=31, Criteria1:="<>"
 
        Derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'Défini la place de celulle et la derniere ligne d'une colonne
 
        For I = 2 To Derlig 'pour I de 1 à la dernière ligne
 
        'ajoute les données dans la listBox1
            If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
                    ListBox1.AddItem .Range("A" & I).Value
                    ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
                    ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
                    ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
                    ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
                    ListBox1.List(ListBox1.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
                    ListBox1.List(ListBox1.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
                    ListBox1.List(ListBox1.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
                    ListBox1.List(ListBox1.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
                    ListBox1.List(ListBox1.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
            End If
        Next I
        .ShowAllData
    End With 'fin du with
 
'Filtre arrivé/départ 4
 
    Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=21, Criteria1:="<>"
    Selection.AutoFilter Field:=24, Criteria1:=""
 
 
 
    With Sheets("Base de données") 'dans la feuille Base de données
 
        If RECHMOD.CBoxUM.Value <> "" Then Selection.AutoFilter Field:=2, Criteria1:=RECHMOD.CBoxUM.Value
        If RECHMOD.CBoxType.Value <> "" Then Selection.AutoFilter Field:=3, Criteria1:=RECHMOD.CBoxType.Value
        If RECHMOD.CBoxMateriel.Value <> "" Then Selection.AutoFilter Field:=4, Criteria1:=RECHMOD.CBoxMateriel.Value
        If RECHMOD.CBoxNOrgane.Value <> "" Then Selection.AutoFilter Field:=5, Criteria1:=RECHMOD.CBoxNOrgane.Value
        If RECHMOD.CBoxTache.Value <> "" Then Selection.AutoFilter Field:=6, Criteria1:=RECHMOD.CBoxTache.Value
        If RECHMOD.CBoxVersion.Value <> "" Then Selection.AutoFilter Field:=7, Criteria1:=RECHMOD.CBoxVersion.Value
        If RECHMOD.CBoxDocValide.Value = "Oui" Then Selection.AutoFilter Field:=31, Criteria1:="<>"
 
        Derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'Défini la place de celulle et la derniere ligne d'une colonne
 
        For I = 2 To Derlig 'pour I de 1 à la dernière ligne
 
        'ajoute les données dans la listBox1
            If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
                    ListBox1.AddItem .Range("A" & I).Value
                    ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
                    ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
                    ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
                    ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
                    ListBox1.List(ListBox1.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
                    ListBox1.List(ListBox1.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
                    ListBox1.List(ListBox1.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
                    ListBox1.List(ListBox1.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
                    ListBox1.List(ListBox1.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
            End If
        Next I
        .ShowAllData
    End With 'fin du with
 
'Filtre arrivé/départ 5
 
    Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=25, Criteria1:="<>"
    Selection.AutoFilter Field:=28, Criteria1:=""
 
 
 
    With Sheets("Base de données") 'dans la feuille Base de données
          If RECHMOD.CBoxUM.Value <> "" Then Selection.AutoFilter Field:=2, Criteria1:=RECHMOD.CBoxUM.Value
        If RECHMOD.CBoxType.Value <> "" Then Selection.AutoFilter Field:=3, Criteria1:=RECHMOD.CBoxType.Value
        If RECHMOD.CBoxMateriel.Value <> "" Then Selection.AutoFilter Field:=4, Criteria1:=RECHMOD.CBoxMateriel.Value
        If RECHMOD.CBoxNOrgane.Value <> "" Then Selection.AutoFilter Field:=5, Criteria1:=RECHMOD.CBoxNOrgane.Value
        If RECHMOD.CBoxTache.Value <> "" Then Selection.AutoFilter Field:=6, Criteria1:=RECHMOD.CBoxTache.Value
        If RECHMOD.CBoxVersion.Value <> "" Then Selection.AutoFilter Field:=7, Criteria1:=RECHMOD.CBoxVersion.Value
        If RECHMOD.CBoxDocValide.Value = "Oui" Then Selection.AutoFilter Field:=31, Criteria1:="<>"
        Derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'Défini la place de celulle et la derniere ligne d'une colonne
 
        For I = 2 To Derlig 'pour I de 1 à la dernière ligne
 
        'ajoute les données dans la listBox1
            If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
                    ListBox1.AddItem .Range("A" & I).Value
                    ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
                    ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
                    ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
                    ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
                    ListBox1.List(ListBox1.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
                    ListBox1.List(ListBox1.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
                    ListBox1.List(ListBox1.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
                    ListBox1.List(ListBox1.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
                    ListBox1.List(ListBox1.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
            End If
        Next I
        .ShowAllData
    End With 'fin du with
 
Else
 
With Sheets("Base de données") 'dans la feuille Base de données
 
        If RECHMOD.CBoxUM.Value <> "" Then Selection.AutoFilter Field:=2, Criteria1:=RECHMOD.CBoxUM.Value
        If RECHMOD.CBoxType.Value <> "" Then Selection.AutoFilter Field:=3, Criteria1:=RECHMOD.CBoxType.Value
        If RECHMOD.CBoxMateriel.Value <> "" Then Selection.AutoFilter Field:=4, Criteria1:=RECHMOD.CBoxMateriel.Value
        If RECHMOD.CBoxNOrgane.Value <> "" Then Selection.AutoFilter Field:=5, Criteria1:=RECHMOD.CBoxNOrgane.Value
        If RECHMOD.CBoxTache.Value <> "" Then Selection.AutoFilter Field:=6, Criteria1:=RECHMOD.CBoxTache.Value
        If RECHMOD.CBoxVersion.Value <> "" Then Selection.AutoFilter Field:=7, Criteria1:=RECHMOD.CBoxVersion.Value
        If RECHMOD.CBoxDocValide.Value = "Oui" Then Selection.AutoFilter Field:=31, Criteria1:="<>"
 
        Derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'Défini la place de celulle et la derniere ligne d'une colonne
 
        For I = 2 To Derlig 'pour I de 1 à la dernière ligne
 
        'ajoute les données dans la listBox1
            If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
                    ListBox1.AddItem .Range("A" & I).Value
                    ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
                    ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
                    ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
                    ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
                    ListBox1.List(ListBox1.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
                    ListBox1.List(ListBox1.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
                    ListBox1.List(ListBox1.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
                    ListBox1.List(ListBox1.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
                    ListBox1.List(ListBox1.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
        End If
        Next I
 
    End With 'fin du with
End If
With Sheets("Base de données") 'dans la feuille Base de données
 
I = 1
  'ajoute les données dans la listBox2 titre listbox1
       If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
            ListBox2.AddItem .Range("A" & I).Value
            ListBox2.List(ListBox2.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
            ListBox2.List(ListBox2.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
            ListBox2.List(ListBox2.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
            ListBox2.List(ListBox2.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
            ListBox2.List(ListBox2.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
            ListBox2.List(ListBox2.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
            ListBox2.List(ListBox2.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
            ListBox2.List(ListBox2.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
            ListBox2.List(ListBox2.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
       End If
.ShowAllData
End With 'fin du with
 
'trie par ordre alphabétique le N° FTS
 ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort.SortFields.Add _
        Key:=Range("A1:A1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
ListBox2.Enabled = False
N = ListBox1.ListCount
TextBoxNfiche.Value = N
RECHMOD.Hide
 
End Sub

Afin d'améliorer la lecture et de simplifier les choses j'ai simplifier les répétitions dans le code voici le nouveau code :

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
Private Sub UserForm_Initialize()
Dim N As Integer
Dim I As Long
ListBox1.ColumnCount = 10 'nombre de colonnes la colonne 9 contient le numéro de ligne
ListBox1.ColumnWidths = "0;65;40;50;45;35;225;55;55;55" 'largeur des colonnes
ListBox1.TextAlign = fmTextAlignCenter ' centre le texte dans la listbox
ListBox2.ColumnCount = 10 'nombre de colonnes la colonne 9 contient le numéro de ligne
ListBox2.ColumnWidths = "0;65;40;50;45;35;225;55;55;55" 'largeur des colonnes
ListBox2.TextAlign = fmTextAlignCenter ' centre le texte dans la listbox
 
'trie par ordre alphabétique le N° FTS
 ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort.SortFields.Add _
        Key:=Range("E1:E1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
 Me.ListBox1.MultiSelect = fmMultiSelectSingle
If RECHMOD.CheckBox1 = True Then
 
    'Filtre arrivé/départ 1
    Call triarriv1
    Call filtreadditem
 
    'Filtre arrivé/départ 2
    Call triarriv2
    Call filtreadditem
 
    'Filtre arrivé/départ 3
    Call triarriv3
    Call filtreadditem
 
    'Filtre arrivé/départ 4
    Call triarriv4
    Call filtreadditem
 
    'Filtre arrivé/départ 5
    Call triarriv5
    Call filtreadditem
 
Else
    'Filtre tous
    Call filtreadditem
End If
 
With Sheets("Base de données") 'dans la feuille Base de données
 
I = 1
  'ajoute les données dans la listBox2 titre listbox1
       If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
            ListBox2.AddItem .Range("A" & I).Value
            ListBox2.List(ListBox2.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
            ListBox2.List(ListBox2.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
            ListBox2.List(ListBox2.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
            ListBox2.List(ListBox2.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
            ListBox2.List(ListBox2.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
            ListBox2.List(ListBox2.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
            ListBox2.List(ListBox2.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
            ListBox2.List(ListBox2.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
            ListBox2.List(ListBox2.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
       End If
End With 'fin du with
 
'trie par ordre alphabétique le N° FTS
 ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort.SortFields.Add _
        Key:=Range("A1:A1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Base de données").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
ListBox2.Enabled = False
N = ListBox1.ListCount
TextBoxNfiche.Value = N
RECHMOD.Hide
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub
 
Sub triarriv1()
Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=9, Criteria1:="<>"
    Selection.AutoFilter Field:=12, Criteria1:=""
End Sub
Sub triarriv2()
Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=13, Criteria1:="<>"
    Selection.AutoFilter Field:=16, Criteria1:=""
End Sub
Sub triarriv3()
    Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=17, Criteria1:="<>"
    Selection.AutoFilter Field:=20, Criteria1:=""
End Sub
Sub triarriv4()
Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=21, Criteria1:="<>"
    Selection.AutoFilter Field:=24, Criteria1:=""
End Sub
Sub triarriv5()
   Selection.AutoFilter Field:=32, Criteria1:=""
    Selection.AutoFilter Field:=25, Criteria1:="<>"
    Selection.AutoFilter Field:=28, Criteria1:=""
End Sub
 
Sub filtreadditem()
   With Sheets("Base de données") 'dans la feuille Base de données
          If RECHMOD.CBoxUM.Value <> "" Then Selection.AutoFilter Field:=2, Criteria1:=RECHMOD.CBoxUM.Value
        If RECHMOD.CBoxType.Value <> "" Then Selection.AutoFilter Field:=3, Criteria1:=RECHMOD.CBoxType.Value
        If RECHMOD.CBoxMateriel.Value <> "" Then Selection.AutoFilter Field:=4, Criteria1:=RECHMOD.CBoxMateriel.Value
        If RECHMOD.CBoxNOrgane.Value <> "" Then Selection.AutoFilter Field:=5, Criteria1:=RECHMOD.CBoxNOrgane.Value
        If RECHMOD.CBoxTache.Value <> "" Then Selection.AutoFilter Field:=6, Criteria1:=RECHMOD.CBoxTache.Value
        If RECHMOD.CBoxVersion.Value <> "" Then Selection.AutoFilter Field:=7, Criteria1:=RECHMOD.CBoxVersion.Value
        If RECHMOD.CBoxDocValide.Value = "Oui" Then Selection.AutoFilter Field:=31, Criteria1:="<>"
        Derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'Défini la place de celulle et la derniere ligne d'une colonne
 
        For I = 2 To Derlig 'pour I de 1 à la dernière ligne
 
        'ajoute les données dans la listBox1
            If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
                    ListBox1.AddItem .Range("A" & I).Value
                    ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("A" & I).Offset(0, 2) 'ajoute le type en colonne 1
                    ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("A" & I).Offset(0, 3) 'ajoute le Materiel en colonne 2
                    ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("A" & I).Offset(0, 4) 'ajoute le N° Organe en colonne 3
                    ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("A" & I).Offset(0, 5) 'ajoute la tache en colonne 4
                    ListBox1.List(ListBox1.ListCount - 1, 5) = .Range("A" & I).Offset(0, 6) 'ajoute la Version en colonne 5
                    ListBox1.List(ListBox1.ListCount - 1, 6) = .Range("A" & I).Offset(0, 7) 'ajoute le Observation en colonne 6
                    ListBox1.List(ListBox1.ListCount - 1, 7) = .Range("A" & I).Offset(0, 8) 'ajoute le 1 ére Arrivé en colonne 7
                    ListBox1.List(ListBox1.ListCount - 1, 8) = .Range("A" & I).Offset(0, 30) 'ajoute le Validée le en colonne 8
                    ListBox1.List(ListBox1.ListCount - 1, 9) = .Range("A" & I).Offset(0, 31) 'ajoute le Départ en colonne 9
            End If
        Next I
        .ShowAllData
    End With 'fin du with
End Sub

Je reste à votre disposition pour des conseils de méthode concernant l'optimisation du temps d'exécution d'une macro.
Cordialement,
Passepartout007

**eriiic** · 07/07/2018, 20h00

Bonjour,

tu lis tes cellules une par une, c'est très lent.
Lit ta plage en un bloc dans une variable tableau, et après tu pioches dedans.
Ex :

Code :

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

1
2
3
4
5
6
Dim datas
datas = Sheets("machin").[A2].Resize(derlig - 1, 30).Value
For i = 1 To UBound(datas)
    ListBox1.List(ListBox1.ListCount - 1, 1) = datas(i, 2)
    ' etc
Next i

eric

**Qwazerty** · 08/07/2018, 10h47

Salut

Pour le début

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
'## Thisworkbook plutôt que activeworkbook
With ThisWorkbook.Worksheets("Base de données")
    .AutoFilter.Sort.SortFields.Clear
    .AutoFilter.Sort.SortFields.Add .Range("E1", .Cells(.Rows.Count, "E").End(xlUp)), xlSortOnValues, xlAscending, DataOption:=xlSortNormal
    With .AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With

Pour la suite, en plus du très judicieux conseil d'eriiic, il faut retravailler ton code.

Il faut supprimer tout ces Selection. qu'il y a partout et les remplacer par ce à quoi il correspond.
Ensuite les 4 blocs de code qui se suivent sont quasi totalement identique, il faut que tu fasses une boucle avec à chaque boucle juste modifier les tris, toute la partie écriture dans le listbox est identique.
Faire des boucle pour le remplissage de tes colonne de listbox.

++
Qwaz

**Passepartout007** · 09/07/2018, 08h48

Bonjour eriiic,

J'ai essayer d'incrémenter ta méthode à mon code mais je ne suis apparemment pas assez douer pour le comprendre. Effectivement quand je l'intègre cela mélange les lignes entre elle, il y a donc un mélange de ligne.

voici le code :

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
Sub filtreadditem()
Dim datas
   With Sheets("Base de données") 'dans la feuille Base de données
          If RECHMOD.CBoxUM.Value <> "" Then Selection.AutoFilter Field:=2, Criteria1:=RECHMOD.CBoxUM.Value
        If RECHMOD.CBoxType.Value <> "" Then Selection.AutoFilter Field:=3, Criteria1:=RECHMOD.CBoxType.Value
        If RECHMOD.CBoxMateriel.Value <> "" Then Selection.AutoFilter Field:=4, Criteria1:=RECHMOD.CBoxMateriel.Value
        If RECHMOD.CBoxNOrgane.Value <> "" Then Selection.AutoFilter Field:=5, Criteria1:=RECHMOD.CBoxNOrgane.Value
        If RECHMOD.CBoxTache.Value <> "" Then Selection.AutoFilter Field:=6, Criteria1:=RECHMOD.CBoxTache.Value
        If RECHMOD.CBoxVersion.Value <> "" Then Selection.AutoFilter Field:=7, Criteria1:=RECHMOD.CBoxVersion.Value
        If RECHMOD.CBoxDocValide.Value = "Oui" Then Selection.AutoFilter Field:=31, Criteria1:="<>"
        derlig = .Range("A" & .Rows.Count).End(xlUp).Row 'Défini la place de celulle et la derniere ligne d'une colonne
 
        datas = Sheets("Base de données").[A2].Resize(derlig - 1, 31).Value
        For I = 1 To UBound(datas) 'pour I de 1 à la dernière ligne
 
        'ajoute les données dans la listBox1
 
 
            If .Range("A" & I).EntireRow.Hidden = False Then 'si la cellule est visible alors faire les étapes suivante sinon end if
 
                    ListBox1.AddItem .Range("A" & I).Value
                     ListBox1.List(ListBox1.ListCount - 1, 0) = datas(I, 1)
                    ListBox1.List(ListBox1.ListCount - 1, 1) = datas(I, 2)
                    ListBox1.List(ListBox1.ListCount - 1, 2) = datas(I, 3)
                    ListBox1.List(ListBox1.ListCount - 1, 3) = datas(I, 4)
                    ListBox1.List(ListBox1.ListCount - 1, 4) = datas(I, 5)
                    ListBox1.List(ListBox1.ListCount - 1, 5) = datas(I, 6)
                    ListBox1.List(ListBox1.ListCount - 1, 6) = datas(I, 7)
                    ListBox1.List(ListBox1.ListCount - 1, 7) = datas(I, 8)
                    ListBox1.List(ListBox1.ListCount - 1, 8) = datas(I, 30)
                    ListBox1.List(ListBox1.ListCount - 1, 9) = datas(I, 31)
 
            End If
        Next I
        .ShowAllData
    End With 'fin du with
End Sub

Je ne comprend pas ce qui ce passe, de plus la macro reste lente j'ai donc un problème de sélect.

Bonjour a toi qwazerty, je comprend que tes filtres se font avec la fonction.Sort au lieux d'un sélect, pense tu que cela influe beaucoup la fluidité de ma macro ?
Je ne comprend pas ton code ou ce que tu à écrit, je l'ai moi même dans mon code mais c'est une récup d'une autre discutions.
Pourrais tu me commenté quelque ligne (si ce n'est pas trop de boulot pour toi bien sur).

Je tiens quand même à vous remercier pour votre aide et m'avoir apporter des pistes d'améliorations.
Cordialement,
Passepartout007

**Qwazerty** · 09/07/2018, 12h15

Salut

Mon code n'avais pas pour but d'accélérer ta macro mais de t'éviter de futurs éventuels problèmes.

Pour améliorer le vélocité de ta macro, il te faut faire comme à dit eriiic et utiliser un tableau interne. Par contre pour travailler comme ça, tu ne pourra plus utiliser les filtre auto, il te faudra boucler sur le contenu du tableau interne et déterminer à chaque ligne si celles-ci doivent ou non apparaitre dans ListBox1.

Si rien de confidentiel, peux-tu partager un fichier?

++
Qwaz

**Passepartout007** · 09/07/2018, 13h17

Bonjour,

Malheureusement je ne peux pas divulguer le fichier.
Cependant je peux t'expliquer comment cela fonctionne.
Dans une feuille Excel il y a la base de données ou l'on retrouve des données de la colonne A à BY il y a environs plus de 5000 ligne dans cette page.
Les ligne les plus intéressent sont:
- Colonne A, le n° de fiche ,
- Colonne B, UM ( non des service),
- Colonne C, le type (de fiche),
- Colonne D, le Matériel,
- Colonne E, le N°:d'organe,
- Colonne F, La tache,
- Colonne G, la Version (de la fiche),
- Colonne H, l'observation,

De la colonne I à la Colonne AB pour i = 1 à 5
- Colonne I, i ere arrivé (date),
- Colonne J, Acteur i,
- Colonne K, Contrôleur i,
- Colonne L, i er départ
Puis
- Colonne AE signature,
- Colonne AF Départ.

Je créer donc un userform pour ajouter modifier et supprimé des données de cette base de données.

Dans un Userform appeler RECHMOD voir visuel :

Nom : Image8.PNG
Affichages : 496
Taille : 25,1 Ko

Nom : Image8.PNG
Affichages : 496
Taille : 25,1 Ko

J'indique les différents paramètres Um, Type, ETC
Si je coche En cours de validation cela signifie que la fiche est arrivé (colonne I, M, Q, U, Y) et que la fiche n'est pas partie en associer avec l'arrivé (L, P, T, X,AB) et que le départ final n'as pas été fais colonne AF.

Si je coche Doc Validé alors il m'indique tout les docs ou dans la colonne AE on retrouve une value différent de "".
Si on coche entre deux dates alors la list doit afficher que les fiche validé entre ses deux dates. colonne AE.

Dans l'ensemble j'ai pas mal de critère et j'incrémente donc la liste box suivant l'intégralité de ses critère en en faisans des filtres dans le classeur excel et en incrémentant que les cellules visible.

Visuel de l'userform AfficheRecherche :
Nom : Image9.PNG
Affichages : 523
Taille : 27,2 Ko

Nom : Image9.PNG
Affichages : 523
Taille : 27,2 Ko

Tu me propose de créer une base de données externes qui incrémentera la listbox en choisissant les différente ligne par lui même, cela me permettra sans doute de réduire le temps d'exécution cependant sans les filtre je ne sais pas faire ca. Peux tu m'aider sur ce point.
Je peux tout de même fournir un fichier vierge avec juste les userforms concerner mais sans la base de données la plus part des macro de combobox ne fonctionne pas.

Je reste a votre disposition pour tout complément d'information.
Pour les noms des combobox je vous en laisse le choix, mon but est de comprendre comment cela fonctionne afin que je puisse le reproduire dans mon fichier.
Je rappel que je suis Débutant en VBA j'ai commencer a codé avec se formulaire, je vous demande d'être indulgent sur la qualité du codage.

Cordialement,
Passepartout007

Améliorer les performances générales de la macro [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager