Afficher cellules filtrées dans listbox

Bonsoir cher tous

J'essaie d'afficher mes cellules filtrées dans mon listbox mais ça ne marche pas correctement. Voici le code

Listbox.columsheads= true
Listbox.columncount=38
Listbox.rowsource  ="AL2: A" & (A6000).end(xlup).specialcells(xlcelltypevisible).row

Merci d'avance

Bonsoir,

Vous ne pouvez pas référencer ou charger globalement une liste de valeurs discontinue puisque filtrée. Vous devez passer par une boucle en utilisant la méthode ".additem".

Bonsoir,

Eviter AddItem qui est lent. Utiliser plutôt List ou Column

Private Sub UserForm_Initialize()
  Calculate
  Set f = Sheets("bd")
  Ncol = [_FilterDataBase].SpecialCells(xlCellTypeVisible).Columns.Count
  Dim Liste(): ReDim Liste(1 To [_FilterDataBase].Offset(1).Resize(, 1).SpecialCells(xlCellTypeVisible).Count, 1 To Ncol)
  i = 0
  For Each c In [_FilterDataBase].Offset(1).Resize(, 1).SpecialCells(xlCellTypeVisible)
    i = i + 1
    For k = 1 To Ncol
      Liste(i, k) = c.Offset(, k - 1)
    Next k
    Liste(i, 6) = Format(Liste(i, 6), "hh:mm")   ' adapter ou supprimer
  Next c
  Me.ListBox1.List = Liste

Ceuzin

Bonsoir,

ceuzin a écrit :

Eviter AddItem qui est lent. Utiliser plutôt List ou Column

"List" est plus rapide quand le chargement est global mais à partir du moment où on utilise une boucle, je ne vois pas pourquoi "List(index)" serait plus rapide que "additem".

CF PJ

Boucler sur un Array ou sur un ListBox, ce n'est pas la même chose ! (rapport de 1à 10 au moins)

Filtre avec List

Filtre listbox par clé
plus rapide que Additem
0,1s  pour 2.000  éléments/10.000 (1,6 s pour Additem)

Dim f, bd
Option Compare Text
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set d = CreateObject("Scripting.Dictionary")
  bd = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  Me.ListBox1.List = bd
  For i = LBound(bd) To UBound(bd)
     d(bd(i, 3)) = ""
  Next i
  Me.ComboBox1.List = d.keys
  Me.ListBox1.ColumnCount = 4
  Me.ListBox1.ColumnWidths = "40;30;50;30"
End Sub

Private Sub ComboBox1_click()
  ville = Me.ComboBox1: n = 0
  Dim Tbl()
  For i = 1 To UBound(bd)
    If bd(i, 3) = ville Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(bd, 2), 1 To n)
        For k = 1 To UBound(bd, 2): Tbl(k, n) = bd(i, k): Next k
     End If
  Next i
  Me.ListBox1.Column = Tbl
End Sub

Filtre avec Additem

Dim f, bd
Option Compare Text
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set d = CreateObject("Scripting.Dictionary")
  bd = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  Me.ListBox1.List = bd
  For i = LBound(bd) To UBound(bd)
     d(bd(i, 3)) = ""
  Next i
  Me.ComboBox1.List = d.keys
End Sub

Private Sub ComboBox1_click()
  ville = Me.ComboBox1
  n = 0
  Me.ListBox1.Clear
  For i = LBound(bd) To UBound(bd)
     If bd(i, 3) = ville Then
        Me.ListBox1.AddItem bd(i, 1)
        Me.ListBox1.List(n, 1) = bd(i, 2)
        Me.ListBox1.List(n, 2) = bd(i, 3)
        Me.ListBox1.List(n, 3) = bd(i, 4)
        n = n + 1
     End If
  Next i
End Sub

Ceuzin

Bonjour

Merci a vous pour vos réponses. @Ceuzin je dois avouer tes codes m'ont secoués mais fonctionnent super bien. J'ai du aller faire beaucoup de recherches pour comprendre. Finalement c'est vrai que Additem est plus lent que list mais je préfère celle avec Additem car un peu plus simple

Merci encore!

ceuzin a écrit :

Boucler sur un Array ou sur un ListBox, ce n'est pas la même chose ! (rapport de 1à 10 au moins)

Certes, mais dans ton code, tu as utilisé 2 boucles dont la première sur la feuille "bd" pour créer la collection de type Dictionnaire. Je ne parlais que d'utiliser une seule boucle sur la feuille "bd" filtrée avec "additem" , ce qui est au moins aussi rapide.

Essai pour 20.000 lignes:

Choix d'une ville dans le combobox (temps de réponse):

-List: 0,1 sec

Additem :4 sec

Ceuzin

euhh comment faire pour connaître le temps de réponse du code? je me pose souvent cette question...

Effectivement il est plus rapide de passer par une collection dynamique avec 2 boucles .

>euhh comment faire pour connaître le temps de réponse du code? je me pose souvent cette question...

t=Timer
....
....
MsgBox Timer-t

Essayer le programme du Post 8

Ceuzin

Bonjour

@Ceuzon j'ai essayé de m'inspirer de ton code et ca marche mais ma listbox s'ouvre avec des lignes vides ce qui est normal. J'ai donc essayé de les surpprimer avec la propriété removeIdem mais ca m'affiche le message d'erreur l'indice n'appartient pas à la selection, voici tout mon code

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
UsF_FILTRER.Caption = "RESULTAT FILTRE DE " & Sheets("IMATG").Range("I2").Value
Set f = Sheets("mMATG")
Sheets("mMATG").Visible = True
Sheets("mMATG").Select
Dim tb() 'variable tableau
ReDim tb(f.Range("A6000").End(xlUp).Row, 38)
For i = 2 To Range("A6000").End(xlUp).Row   'Boucle des lignes
    If Sheets("IMATG").Range("I2").Value = f.Range("B" & i).Value Then
        For n = 1 To 38 'boucle des colonnes
        tb(i, n - 1) = Cells(i, n).Value
        Next n
    End If
  Next i
    ListBox1.ColumnCount = 38
    ListBox1.ColumnHeads = True
    ListBox1.AddItem
    For p = 0 To ListBox1.ListCount - 1
 If ListBox1.List(p) = "" Then
  ListBox1.RemoveItem (p)
  End If
Next p
Sheets("mMATG").Visible = False
Application.ScreenUpdating = True
End Sub

Je sais pas pourquoi dans mon cas la propriété removeidem ne marche pas

Et existe t il un code qui permet que d'inserer uniquement les lignes du tableau non vides dans la listbox?

Merci