VBA temps d'exécution trop lent
Bonjour,
Je suis confronté à un problème que je n’arrive pas à résoudre.
Contexte :
J’ai une feuille Excel nommé BD qui contient des caractéristiques sur des outils, ces outils possèdent une catégorie, sous-catégorie, un numéro unique, un site de vente et d’autres caractéristiques.
J’ai défini une plage de données qui va me permettre d’effectuer des recherches à l’aide de Combobox.
Chaque Combobox effectue un tri sur une colonne de la plage de données, le résultat s’affiche dans une listbox.
Mon problème c’est que le code prend beaucoup de temps lorsque j’ai trop de ligne à traiter (10000 lignes), donc j’aimerais savoir si quelqu’un à une idée pour réduire le tempsd’execution.
Voilà, merci d'avance pour vos réponses.
Ci-dessous le code utilisé.
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
| Private Sub UserForm_Initialize()
Me!Label47 = Format(Now, "dd/mm/yyyy")
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
noCol = 1: ListeCol 1
noCol = 2: ListeCol 2
noCol = 3: ListeCol 3
noCol = 4: ListeCol 4
noCol = 5: ListeCol 5
On Error Resume Next
ListBox1.Clear
UserForm5.Repaint
End Sub
Private Sub ComboBox1_DropButtonClick()
noCol = 1: ListeCol 1
End Sub
Private Sub ComboBox2_DropButtonClick()
noCol = 2: ListeCol 2
End Sub
Private Sub ComboBox3_DropButtonClick()
noCol = 3: ListeCol 3
End Sub
Private Sub ComboBox4_DropButtonClick()
noCol = 4: ListeCol 4
End Sub
Private Sub ComboBox5_DropButtonClick()
noCol = 5: ListeCol 5
End Sub
Sub ListeCol(noCol)
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To [bd].Rows.Count
ok = True
For n = 1 To [bd].Columns.Count
If n <> noCol Then
If Not Range("bd").Cells(i, n) Like Me("comboBox" & n) Then ok = False
End If
Next n
If ok Then
tmp = Range("BD").Cells(i, noCol)
MonDico(tmp) = tmp
End If
Next i
MonDico.Add "", ""
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me("ComboBox" & noCol).List = temp
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
ref = CStr(a((gauc + droi) \ 2))
g = gauc: d = droi
Do
Do While CStr(a(g)) < ref: g = g + 1: Loop
Do While ref < CStr(a(d)): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub
Private Sub ComboBox1_Change()
filtre ' filtre par sous categorie
End Sub
Private Sub ComboBox2_Change()
filtre
End Sub
Private Sub ComboBox3_Change()
filtre
End Sub
Private Sub ComboBox4_Change()
filtre
End Sub
Private Sub ComboBox5_Change()
filtre
End Sub
Sub filtre()
ligne = 0
Me.ListBox1.Clear
For i = 1 To [bd].Rows.Count
ok = True
For n = 1 To [bd].Columns.Count
If Not Range("bd").Cells(i, n) Like Me("comboBox" & n) Then ok = False
Next n
If ok Then
Me.ListBox1.AddItem
For k = 1 To [bd].Columns.Count
Me.ListBox1.List(ligne, k - 1) = Range("bd").Cells(i, k)
Next k
ligne = ligne + 1
End If
Next i
On Error Resume Next
End Sub |
