XL 2013 Tri sur listbox par textbox

[franxy]

Bonjour,
Je cherchai le moyen de faire un tri sur une listbox
M. BOISGONTIER a créé un formulaire qui fonctionne tres bien (FormIntituive3)
J'ai bien entendu, transféré ce code sur un fichier classeur1. Cela ne fonctionne pas, je ne vois pas pourquoi.
J'ai laissé les deux options :
Option Explicit
Option compare text

car en amont, le formulaire final insert d'autre textbox et listbox
Je ne sais d'ailleurs si ces 2 options sont compatibles dans le même formulaire, un avis supplémentaire ?

Pouvez-vous m'aider sur le non fonctionnement sur mon Classeur1 ?
Merci

 

[ChTi160]

Re
le fichier avec le Code pour définir les Propriétés de la ListBox
Jean marie

 

[franxy]

Je vais regarder cela.
Je comprends pas ça déja, où je supprime qqchose ?

BOnne journér

 

[ChTi160]

Re
Pour essayer s'expliquer cela

Tablo= .Resize(.Rows.Count+2,

.Resize() permet de redimensionner (virtuellement) la plage du tableau source .Rows.Count correspond au nombre de lignes de la plage source
Le + 2 veut dire qu'on agrandit (virtuellement ) la plage qui sera récupérée dans le tableau (+2 lignes) ça n'a aucun effet sur la plage source.
Jean marie

 

[franxy]

Je me suis enfin souvenu que l'on pouvait modifier la listbox dans les propriétés....
Cela fonctionne très bien ainsi
Merci à vous deux
Sans aucun doute, je reviendrai vers vous, sauf miracle...

 

[patricktoulon]

re
Bonjour tout les deux
jean-marie il faudra quand même m'expliquer pourquoi ajouter le filtre de la plage a mon code de listefiltree
c'est absolument inutile

 

[patricktoulon]

Je vais regarder cela.
Je comprends pas ça déja, où je supprime qqchose ?
Regarde la pièce jointe 1195480
BOnne journér

l'explication de jean-marie n'est pas suffisante
en fait je resize +2 en ligne et +1 en colonne

+1 en colonne pour lettre les indexs de ligne en dernière colonne
+ 2 en ligne pour ne pas être obligé de controler avant de mettre dans le .list si il y a des items ou pas
par ce que si 0 .list =tbl donne une erreur
si 1 seul .list=tbl donne la ligne transposé il faut faire .column=application.transpose(tbl)

donc pour ne pas m’ennuyer, je prend quand même 2 lignes minimum sur colonne+1
j'envoie dans la liste et je delete a reculons si lignes vide a partir d'en bas de la liste
tout simplement

 

[ChTi160]

Bonjour Patrick ,le Fil ,Le Forum

Dans cette procédure , que doit on avoir en retour si le Tableau est Vide ?

Sub reliste(LO As ListObject, lst)
    Dim i&
    With LO.DataBodyRange: tablo = .Resize(.Rows.Count + 2, .Columns.Count + 1).Value: Set LTO = LO: End With
    For i = 1 To UBound(tablo): tablo(i, UBound(tablo, 2)) = i: Next
    lst.List = tablo
    For i = lst.ListCount - 1 To 0 Step -1
        If lst.List(i, 0) = "" Then lst.RemoveItem (i)
    Next
End Sub

Ne faut il pas tester si Le "DataBodyRange" est Vide ?
Moi sous cette forme , j'ai un message d'erreur .
Pour ce qui est du Tri (de la colonne " Nom " de la plage, c'était juste pour avoir une Liste triée dans la Listbox (pas obligatoire) !
Bonne Journée
Jean marie

 

[patricktoulon]

re
et oui vous partez du TS
au debut je vous l'ai fait
ensuite vous etes parti sur LO qui est un listobject
le problème comme ca c'est que le databodyrange va donner une erreur forcement si le tableau est vide

donc je le redonne une Nieme fois
arrêtez de chercher a compliquer quelque chose de simple
sincèrement que veux tu faire de plus simple ?

Dim tablo
Dim LTO As ListObject

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Listefiltrée ListBox1, TextBox1.Value, 1
End Sub

Private Sub UserForm_Activate()
    reliste Range("Bdd").ListObject, ListBox1
End Sub
Sub reliste(LO As ListObject, lst)
    Dim i&
    With Range(LO.Name): tablo = .Resize(.Rows.Count + 2, .Columns.Count + 1).Value: Set LTO = LO: End With
    For i = 1 To UBound(tablo): tablo(i, UBound(tablo, 2)) = i: Next
    lst.List = tablo
    For i = lst.ListCount - 1 To 0 Step -1
        If lst.List(i, 0) = "" Then lst.RemoveItem (i)
    Next
End Sub


Sub Listefiltrée(Lbox, valeur, Optional col& = -1)
    Dim tbl(), a&, i&, c&
    If col = -1 Then col = LBound(tablo, 2)
    For i = LBound(tablo) To UBound(tablo)
        If LCase(tablo(i, col)) Like LCase(valeur) & "*" Then
            a = a + 1: ReDim Preserve tbl(LBound(tablo, 2) To UBound(tablo, 2), 1 To a):
            For c = LBound(tablo, 2) To UBound(tablo, 2): tbl(c, a) = tablo(i, c): Next
        End If
    Next
    If a = 0 Or valeur = "" Then
        '*******************************
        'Fonctionnement au choix pour la non correspondance
        Lbox.Clear: Exit Sub   ' aucune correspondence la liste est vide
        'ou
        'reliste LTO, Lbox       ' aucune correspondance alors tout
        '********************************
    Else
        tbl = Application.Transpose(tbl)
        If a > 1 Then Lbox.List = tbl Else If a > 0 Then Lbox.Column = tbl
    End If
End Sub

j'ai suivi comme ça en passant depuis le post #5
vous n'avez fait que vous compliquer la vie alors que je vous ai donné un code minimal
parfaitement fonctionnel en tout cas sur 2007 , 2013 , 2016

 

[franxy]

re
et oui vous partez du TS
au debut je vous l'ai fait
ensuite vous etes parti sur LO qui est un listobject
le problème comme ca c'est que le databodyrange va donner une erreur forcement si le tableau est vide

donc je le redonne une Nieme fois
arrêtez de chercher a compliquer quelque chose de simple
sincèrement que veux tu faire de plus simple ?

Dim tablo
Dim LTO As ListObject

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Listefiltrée ListBox1, TextBox1.Value, 1
End Sub

Private Sub UserForm_Activate()
    reliste Range("Bdd").ListObject, ListBox1
End Sub
Sub reliste(LO As ListObject, lst)
    Dim i&
    With Range(LO.Name): tablo = .Resize(.Rows.Count + 2, .Columns.Count + 1).Value: Set LTO = LO: End With
    For i = 1 To UBound(tablo): tablo(i, UBound(tablo, 2)) = i: Next
    lst.List = tablo
    For i = lst.ListCount - 1 To 0 Step -1
        If lst.List(i, 0) = "" Then lst.RemoveItem (i)
    Next
End Sub


Sub Listefiltrée(Lbox, valeur, Optional col& = -1)
    Dim tbl(), a&, i&, c&
    If col = -1 Then col = LBound(tablo, 2)
    For i = LBound(tablo) To UBound(tablo)
        If LCase(tablo(i, col)) Like LCase(valeur) & "*" Then
            a = a + 1: ReDim Preserve tbl(LBound(tablo, 2) To UBound(tablo, 2), 1 To a):
            For c = LBound(tablo, 2) To UBound(tablo, 2): tbl(c, a) = tablo(i, c): Next
        End If
    Next
    If a = 0 Or valeur = "" Then
        '*******************************
        'Fonctionnement au choix pour la non correspondance
        Lbox.Clear: Exit Sub   ' aucune correspondence la liste est vide
        'ou
        'reliste LTO, Lbox       ' aucune correspondance alors tout
        '********************************
    Else
        tbl = Application.Transpose(tbl)
        If a > 1 Then Lbox.List = tbl Else If a > 0 Then Lbox.Column = tbl
    End If
End Sub

j'ai suivi comme ça en passant depuis le post #5
vous n'avez fait que vous compliquer la vie alors que je vous ai donné un code minimal
parfaitement fonctionnel en tout cas sur 2007 , 2013 , 2016

Les deux fonctionnent bien.... Merci