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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
319
Réponses
3
Affichages
514
Réponses
5
Affichages
333
  • Question Question
Microsoft 365 Erreur UBound
Réponses
4
Affichages
153
Réponses
8
Affichages
496
Réponses
5
Affichages
269
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…