XL 2016 Afficher resultat filtre dans listbox

[KTM]

Bonjour chers tous
Dans le fichier joint je voudrais filtrer mes totaux et afficher le résultat dans mon listbox.
Mais j'ai l'impression que ca fonctionne mal.
Prière m'aider..
Merci!!!

 

[patricktoulon]

Bonjour

1° tu ne peux pas mettre une plage filtré dans une listbox comme ça forcement tu aura que la première area contiguë
une plage non contigue est incompatible avec une listbox il me semble te l'avoir déjà dit

tu es donc obligé de créer une variable tableau et la dimensionner et la remplir dynamico
transposer vu que l'on a x lignes et y colonnes
ps: transposé par ce que (on ne peut redimensionner que la dernière dimension dans une variable tableau)

2°ensuite une plage avec l'adresse en dur semble faire penser qu'elle n’évoluera pas
si c'est le cas OK mais sinon il te faut la dimensionner avec le end (xlup) d'une des colonnes

3° pour ne pas se soucier du point (2°) , combien de fois faudra t il te dire que travailler avec un tableau structuré te sera plus facile


le code dans ton userform

Option Explicit
Option Compare Text
Dim tbl()    'tableau entier
Dim tbl2()    'tableau filtré
Dim plage As Range, i&
Private Sub Filter_Click()
    Dim area, ro, a&, c&
    Application.ScreenUpdating = False
    With Sheets("Tab")
         If .AutoFilterMode Then
            .AutoFilterMode = False
            Set plage = .Range("A3:P" & .Cells(Rows.Count, "A").End(xlUp).Row)
            tbl = plage.Value
            ListBox1.List = tbl
            Set plage = Nothing
        Else
            Set plage = .Range("$A$2:$P" & .Cells(Rows.Count, "A").End(xlUp).Row)
            plage.AutoFilter Field:=16, Criteria1:=">0"
            Set plage = .Range("A3:P23").SpecialCells(xlCellTypeVisible)
            For Each area In plage.Areas
                For Each ro In area.Rows
                    If ro.Cells(16) > 0 Then
                    End If
                    a = a + 1: ReDim Preserve tbl2(1 To 16, 1 To a)
                    For c = 1 To 16: tbl2(c, a) = ro.Cells(c): Next
                Next
            Next
            ListBox1.List = Application.Transpose(tbl2)
        End If
    End With
    Set plage = Nothing
    Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
    Application.ScreenUpdating = False
    With Sheets("Tab")
        Set plage = .Range("A3:P23")
        tbl = plage.Value
        ListBox1.List = tbl
        entetes.Column = Application.Transpose(.[A2].Resize(1, 16).Value)
    End With
End Sub

Bonne journée

 

[KTM]

Bonjour

1° tu ne peux pas mettre une plage filtré dans une listbox comme ça forcement tu aura que la première area contiguë
une plage non contigue est incompatible avec une listbox il me semble te l'avoir déjà dit

tu es donc obligé de créer une variable tableau et la dimensionner et la remplir dynamico
transposer vu que l'on a x lignes et y colonnes
ps: transposé par ce que (on ne peut redimensionner que la dernière dimension dans une variable tableau)

2°ensuite une plage avec l'adresse en dur semble faire penser qu'elle n’évoluera pas
si c'est le cas OK mais sinon il te faut la dimensionner avec le end (xlup) d'une des colonnes

3° pour ne pas se soucier du point (2°) , combien de fois faudra t il te dire que travailler avec un tableau structuré te sera plus facile


le code dans ton userform

Option Explicit
Option Compare Text
Dim tbl()    'tableau entier
Dim tbl2()    'tableau filtré
Dim plage As Range, i&
Private Sub Filter_Click()
    Dim area, ro, a&, c&
    Application.ScreenUpdating = False
    With Sheets("Tab")
         If .AutoFilterMode Then
            .AutoFilterMode = False
            Set plage = .Range("A3:P" & .Cells(Rows.Count, "A").End(xlUp).Row)
            tbl = plage.Value
            ListBox1.List = tbl
            Set plage = Nothing
        Else
            Set plage = .Range("$A$2:$P" & .Cells(Rows.Count, "A").End(xlUp).Row)
            plage.AutoFilter Field:=16, Criteria1:=">0"
            Set plage = .Range("A3:P23").SpecialCells(xlCellTypeVisible)
            For Each area In plage.Areas
                For Each ro In area.Rows
                    If ro.Cells(16) > 0 Then
                    End If
                    a = a + 1: ReDim Preserve tbl2(1 To 16, 1 To a)
                    For c = 1 To 16: tbl2(c, a) = ro.Cells(c): Next
                Next
            Next
            ListBox1.List = Application.Transpose(tbl2)
        End If
    End With
    Set plage = Nothing
    Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
    Application.ScreenUpdating = False
    With Sheets("Tab")
        Set plage = .Range("A3:P23")
        tbl = plage.Value
        ListBox1.List = tbl
        entetes.Column = Application.Transpose(.[A2].Resize(1, 16).Value)
    End With
End Sub

Bonne journée

Merci infiniment.
En plus de me donner le poisson vous m'apprenez à pêcher.
Demeurez remerciés!!