Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Transfert BD dans ListBox sans les lignes vides

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
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

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

  • FormSuppresionLignesVides.xls
    629.5 KB · Affichages: 58
Dernière édition:

Discussions similaires

Réponses
4
Affichages
213
Réponses
11
Affichages
296
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…