Transfert BD dans ListBox sans les lignes vides

[BOISGONTIER]

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

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

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

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

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

 

[job75]

Re : Transfert BD dans ListBox sans les lignes vides

Bonjour Jacques, le forum,

Merci d'avoir rappelé ces 3 méthodes, les comparaisons sont fort utiles.

Bonne journée.