Bonjour,
Pour transférer une BD dans un ListBox sans les lignes vides, la méthode classique consiste à utiliser AddItem.
Pour 10.000 lignes et 4 colonnes, on obtient un temps de 6 secondes
Avec Dictionary, on obtient 0,2 seconde
Avec ArrayList, on obtient 0,5 seconde
Version triée
JB
Formation Excel VBA JB
Pour transférer une BD dans un ListBox sans les lignes vides, la méthode classique consiste à utiliser AddItem.
Pour 10.000 lignes et 4 colonnes, on obtient un temps de 6 secondes
Code:
Private Sub UserForm_Initialize()
a = [A2:D10000].Value
j = 0
For i = LBound(a) To UBound(a)
If a(i, 1) <> "" Then
Me.ListBox1.AddItem a(i, 1)
Me.ListBox1.List(j, 1) = a(i, 2)
Me.ListBox1.List(j, 2) = a(i, 3)
Me.ListBox1.List(j, 3) = a(i, 4)
j = j + 1
End If
Next i
End Sub
Avec Dictionary, on obtient 0,2 seconde
Code:
Private Sub UserForm_Initialize()
Set f = Sheets("bd")
Set d = CreateObject("Scripting.Dictionary")
a = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
For i = LBound(a) To UBound(a)
If a(i, 1) <> "" Then d(i) = Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4))
Next i
Me.ListBox1.List = Application.Transpose(Application.Transpose(d.items))
End Sub
Avec ArrayList, on obtient 0,5 seconde
Code:
Private Sub UserForm_Initialize()
Set AL = CreateObject("System.Collections.ArrayList")
a = [A2:D7].Value
For i = LBound(a) To UBound(a)
If a(i, 1) <> "" Then AL.Add Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4))
Next i
Me.ListBox1.List = Application.Transpose(Application.Transpose(AL.toarray))
End Sub
Version triée
Code:
Option Compare Text
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Set d = CreateObject("Scripting.Dictionary")
a = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value
For i = LBound(a) To UBound(a)
If a(i, 1) <> "" Then d(i) = Array(a(i, 1), a(i, 2), a(i, 3))
Next i
a = Application.Transpose(Application.Transpose(d.items))
Call tri(a, LBound(a), UBound(a), 1)
Me.ListBox1.List = a
End Sub
Sub tri(a, gauc, droi, colTri) ' Quick sort
ref = a((gauc + droi) \ 2, colTri)
g = gauc: d = droi
Do
Do While a(g, colTri) < ref: g = g + 1: Loop
Do While ref < a(d, colTri): d = d - 1: Loop
If g <= d Then
For c = LBound(a, 2) To UBound(a, 2)
temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
Next
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi, colTri)
If gauc < d Then Call tri(a, gauc, d, colTri)
End Sub
JB
Formation Excel VBA JB
Pièces jointes
Dernière édition: