XL 2013 Tri sur listbox par textbox

F

franxy

XLDnaute Junior
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
 

Pièces jointes

  • Classeur1.xlsm
    22.2 KB · Affichages: 7
  • FormIntuitive3.xls
    58.5 KB · Affichages: 6
Solution
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 ?
VB: 
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...
Trier par date Trier par votes
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour frangy
ce que j'ai modifié et semble fonctionné (perfectible!)
j'utilise le tableau structuré que j'ai Nommé "t_BDD"
VB: 
Option Explicit

Option Compare Text
Dim f, Tbl
Private Sub UserForm_Initialize()
Tbl = Range("t_BDD").ListObject.DataBodyRange.Resize(, 4).Value
'ou
'Tbl = Range("t_BDD").Resize(, 4).Value
  Me.ListBox1.List = Tbl
End Sub

Private Sub TextBox1_Change()
Dim n As Integer, i As Integer, clé
 Me.ListBox1.Clear
 n = 0
 clé = Me.TextBox1 & "*"
 For i = 1 To UBound(Tbl)
   If Tbl(i, 2) Like clé Then
      Me.ListBox1.AddItem
      Me.ListBox1.List(n, 0) = Tbl(i, 1)
      Me.ListBox1.List(n, 1) = Tbl(i, 2)
      Me.ListBox1.List(n, 2) = Tbl(i, 3)
      Me.ListBox1.List(n, 3) = Tbl(i, 4)
      n = n + 1
   End If
 Next i
End Sub
à voir
Bonne Journée
Jean marie
 
Vote positif 0 Vote négatif
F

franxy

XLDnaute Junior
ChTi160 à dit:
Bonjour frangy
ce que j'ai modifié et semble fonctionné (perfectible!)
j'utilise le tableau structuré que j'ai Nommé "t_BDD"
VB: 
Option Explicit

Option Compare Text
Dim f, Tbl
Private Sub UserForm_Initialize()
Tbl = Range("t_BDD").ListObject.DataBodyRange.Resize(, 4).Value
'ou
'Tbl = Range("t_BDD").Resize(, 4).Value
  Me.ListBox1.List = Tbl
End Sub

Private Sub TextBox1_Change()
Dim n As Integer, i As Integer, clé
 Me.ListBox1.Clear
 n = 0
 clé = Me.TextBox1 & "*"
 For i = 1 To UBound(Tbl)
   If Tbl(i, 2) Like clé Then
      Me.ListBox1.AddItem
      Me.ListBox1.List(n, 0) = Tbl(i, 1)
      Me.ListBox1.List(n, 1) = Tbl(i, 2)
      Me.ListBox1.List(n, 2) = Tbl(i, 3)
      Me.ListBox1.List(n, 3) = Tbl(i, 4)
      n = n + 1
   End If
 Next i
End Sub
à voir
Bonne Journée
Jean marie
Cliquez pour agrandir...
Merci d'avoir regardé mais j'ai un message d'erreur que voilà
1713517191629.png

EN regardant de plus près et modifiant exactement le range "Tableau2" j'ai bien la listbox qui se charge, mais dès que l'on filtre, elle s'efface, d'ailleurs dans le fichier FormIntituive3 les colonnes se chargent dans la listbox, avec mon fichier, non .... et le code est le meme
1713517328980.png

1713517376443.png

Voilà mon code
1713518136353.png

Mystere ?
 

Pièces jointes

  • 1713518088528.png
    1713518088528.png
    45.3 KB · Affichages: 8
Vote positif 0 Vote négatif
F

franxy

XLDnaute Junior
patricktoulon à dit:
Bonjour
un exemple facon patosh
tiré de ma méthode encore proposé récemment pour cathoqique

colonne de tri aux choix
choix du rendu si aucune correspondances ( vide ou pleine)
Cliquez pour agrandir...
Cela fonctionne, merci
Mais j'aimerai bien pouvoir déchiffrer ce code.... je ne saisis pas tout
Exemple : si je ne veux pas les entetes dans la listbox, je ne sais pas où agir.... :(
Je vais essayer d'inserer cela dans mon projet qui est en Option Explicit
cela ne pose pas de probleme à priori
 
Dernière édition:
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
en attendant la version de Patrick
ce que j'ai modifié , ne traiter que le Databodyrange du Tableau (perfectible)

VB: 
Sub reliste(LO As ListObject, lst)
    Dim i&
    With LO.DataBodyRange 'Avec le dataBodyRange du Tableau
                .Sort key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes 'je trie               
              tablo = .Resize(, .Columns.Count + 1).Value: Set LTO = LO: End With 'On récupére les Données dde la palge ainsi définie'
    For i = 1 To UBound(tablo): tablo(i, UBound(tablo, 2)) = i: Next 'On récupére l'index des Lignes          
           lst.List = tablo 'On colle le tableau dans la ListBox          
    For i = lst.ListCount - 1 To 0 Step -1 'On recherche d'eventuelles Lignes vides
        If lst.List(i, 0) = "" Then lst.RemoveItem (i) 'Pour les supprimer'
    Next
End Sub
je n'ai pas conservé l'ajout de deux Ligne au Tableau (Pourquoi ces deux Lignes
Jean marie
 
Vote positif 0 Vote négatif
F

franxy

XLDnaute Junior
ChTi160 à dit:
Re
en attendant la version de Patrick
ce que j'ai modifié , ne traiter que le Databodyrange du Tableau (perfectible)

VB: 
Sub reliste(LO As ListObject, lst)
    Dim i&
    With LO.DataBodyRange 'Avec le dataBodyRange du Tableau
                .Sort key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes 'je trie              
              tablo = .Resize(, .Columns.Count + 1).Value: Set LTO = LO: End With 'On récupére les Données dde la palge ainsi définie'
    For i = 1 To UBound(tablo): tablo(i, UBound(tablo, 2)) = i: Next 'On récupére l'index des Lignes         
           lst.List = tablo 'On colle le tableau dans la ListBox         
    For i = lst.ListCount - 1 To 0 Step -1 'On recherche d'eventuelles Lignes vides
        If lst.List(i, 0) = "" Then lst.RemoveItem (i) 'Pour les supprimer'
    Next
End Sub
je n'ai pas conservé l'ajout de deux Ligne au Tableau (Pourquoi ces deux Lignes
Jean marie
Cliquez pour agrandir...
Non cela ne donne rien, cela ne charge même pas la Bdd, d'ailleurs je ne le vois pas apparaitre dans le code, même en remplacant Tablo par Bdd, ... arggghhh
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour franxy
arrgggggg ! mdr Voir la vidéo !
ou as tu vu que j'ai remplacé "Tablo" par "Bdd"
Tablo et Un Tableau temporaire , qui va contenir les valeurs de la plage du Tableau Structuré "Bdd"
le Code du Fichier :
VB: 
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 LO.DataBodyRange
                .Sort key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes         
              tablo = .Resize(, .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
Bonne continuation
Jean marie
 

Pièces jointes

  • franxy-2.gif
    franxy-2.gif
    329.1 KB · Affichages: 8
Dernière édition:
Vote positif 0 Vote négatif
F

franxy

XLDnaute Junior
Merci, j'avance un peu. Le chargement de la listbox se fait, le tri par la textbox aussi
Par contre les colonnes à part la premiere, ne se chargent pas
Le VBA est stricto sensus le meme, ton exemple animé est super c'est cela que je recherche
J'ai remis mon classeur au besoin
Merci encore
 

Pièces jointes

  • Classeur1(1).xlsm
    27.7 KB · Affichages: 2
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
As tu définit pour ta ListBox le Nombre des Colonnes et leur largeur ?
(voir dans les Propriétés ou alors ajouter ces deux propriétés dans le Code )
Jean marie
 

Pièces jointes

  • Classeur1(1) (Chti160).xlsm
    27.9 KB · Affichages: 5
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
bonsoir

pour ne pas avoir les entêtes c'est LO.databodyrange
VB: 
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
 
Vote positif 0 Vote négatif
F

franxy

XLDnaute Junior
Merci
Dans mon projet final, le tri se fait bien à partir de la textbox22
La listbox se charge bien en Colonne A ,la listbox sans entête
Peut etre y a til confusion dans le code final de ce useform ?
Ci-joint le code final de ce userform3 de mon projet final, y a til une erreur qqpart, le reste fonctionnant très bien ( tout ce qui se trouve avant '**********
Merci encore


Option Explicit
Dim tablo
Dim LTO As ListObject

'affiche le calendar pour le textbox16
Private Sub BtCalendar16_Click()
TextBox16 = Calendar.ShowX(TextBox16, 2, 0, 1)
End Sub
'affiche le calendar pour le textbox18
Private Sub BtCalendar18_Click()
TextBox18 = Calendar.ShowX(TextBox18, 2, 0, 1)
End Sub
'affiche le calendar pour le textbox19
Private Sub BtCalendar19_Click()
TextBox19 = Calendar.ShowX(TextBox19, 2, 0, 1)
End Sub
Function show_data_in_listbox1()
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "30;30;120"
Sheets("Bdd_ngap").Activate
Dim lastrow As Long
lastrow = Cells(Rows.Count, "M").End(xlUp).Row
ListBox1.List = Range("M2:O" & lastrow).Value
End Function
Function extract_data_in_listbox1()
Dim row_number As Integer
For row_number = 0 To ListBox1.ListCount
If (ListBox1.Selected(row_number) = True) Then
TextBox21 = ListBox1.List(row_number, 0)
TextBox20 = ListBox1.List(row_number, 1)
End If
Next row_number
End Function


Private Sub ListBox1_Click()
Call extract_data_in_listbox1
End Sub

Private Sub UserForm_Initialize()
BTCalendar16.Picture = Application.CommandBars.GetImageMso("ContentControlDate", 30, 30)
BTCalendar18.Picture = Application.CommandBars.GetImageMso("ContentControlDate", 30, 30)
BTCalendar19.Picture = Application.CommandBars.GetImageMso("ContentControlDate", 30, 30)

Call show_data_in_listbox1


End Sub


'********************************************************************


Private Sub TextBox22_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Listefiltrée ListBox2, TextBox22.Value, 1
End Sub

Private Sub UserForm_Activate()
reliste Range("Bdd_patient").ListObject, ListBox2
End Sub
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


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
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour franxy
le ficher de ce projet est lequel ?
pour ce qui est des Colonnes B et C , il suffit de les masquer dans ta ListBox !
tu récupére l'ensemble de la Ligne via un Tableau de 6 colonnes et tu masques les 2 ème et 3 ème Colonnes .
Soit
VB: 
ListBox1.ColumnCount =6
'et
ListBox1.ColumnWidths="120;0;0;60;60;60
j'attends de savoir ou est le Fichier (textbox22,Userform3 , ListBox2 etc etc)
question
pourquoi ajouter 2 Lignes vides à ton Tableau
Code: 
tablo = .Resize(.Rows.Count + 2
pour les supprimer ensuite !
Code: 
For i = lst.ListCount - 1 To 0 Step -1
If lst.List(i, 0) = "" Then lst.RemoveItem (i)
Next
Bonne Journée
Jean marie
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

N
  • Résolu(e)
Microsoft 365 Récupération données ListBox dans TextBox
2 3
Réponses
35
Affichages
461
NONO14
N
T
  • Question
Listbox 14 colonnes
Réponses
6
Affichages
668
TAL
T
C
  • Résolu(e)
XL 2021 Alimenter Listbox si colonne 3 contient un mot précis
Réponses
5
Affichages
490
Claudinedu13
C
cathodique
  • Résolu(e)
XL 2010 Masque de saisie textbox Téléphone Public
Réponses
8
Affichages
655
cathodique
cathodique
L
  • Question
XL 2016 Test si TextBox rempli par date correcte
2 3
Réponses
30
Affichages
2 K
Lorenzini
L
CGU2022.
  • Question
XL 2013 tri listbox
Réponses
3
Affichages
723
ChTi160
ChTi160
M
  • Question
XL 2019 formulaire vba avec macro filtre avancé problème de copie sur une autre feuille
Réponses
3
Affichages
651
Gégé-45550
Gégé-45550
M
  • Résolu(e)
Microsoft 365 Affichage recherche dans formulaire
Réponses
6
Affichages
784
JHA
J
T
  • Question
XL 2019 Evénement click sur listbox
Réponses
8
Affichages
2 K
JM27
J
T
  • Résolu(e)
XL 2016 Filtrer listbox et amélioration d'un code hypertexte
Réponses
3
Affichages
774
tikazor
T

Membres actuellement en ligne

11 membres et 115 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 717
Messages
2 112 168
Membres
111 448
dernier inscrit
ayment