XL 2016 Rechercher et afficher dans listbox

KTM

XLDnaute Impliqué
Bonsoir chers tous
Je voudrais rechercher des BL et les afficher dans mon List box.
Merci de voir mon fichier joint.
 

Pièces jointes

  • RECH.xlsm
    23 KB · Affichages: 12

patricktoulon

XLDnaute Barbatruc
Bonjour KTM
je t'ai donné une solution simple me semble t il la dernière fois , il suffit de travailler la reconstruction du tableau sur 10 colonnes
c'est à croire que finalement tu ne retiens rien ;)

quand on veux faire une listbox intuitive avec réduction de choix par un textbox on utilise pas ROWSOURCE
car elle n'est plus modifiable après

tu resize ton tableau avec le currentregion par le end(xlup) ce qui te donne A9:J29 alors que l'on s’arrête a 21

je vire tout donc y compris tes label d’entêtes j'ajoute une listbox2 pour me faire l’entêtes dans la quelle je mettrais la ligne 9
et dans la listbox1 je mettrais le reste a partir de la ligne 10

et pour finir il serait peut être temps d'apprendre a travailler avec des tableaux structurés ça simplifie la tache
bref
VB:
Option Explicit
Option Compare Text
Dim tbl
Private Sub TextBox1_Change()
    Dim t(), i&, a&, c&
    With TextBox1
        If .Value = "" Then ListBox1.List = tbl: Exit Sub
        For i = 1 To UBound(tbl)
            If tbl(i, 10) Like .Value & "*" Then
                a = a + 1: ReDim Preserve t(1 To 10, 1 To a)
                For c = 1 To 10: t(c, a) = tbl(i, c): Next
            End If
        Next
        If a > 0 Then ListBox1.List = Application.Transpose(t) Else ListBox1.Clear
    End With
End Sub

Private Sub UserForm_Initialize()
    With Sheets("List")
        entetes.Column = Application.Transpose(.[A9].Resize(1, 10).Value)
        tbl = .Range("A10:J" & .Range("A" & Rows.Count).End(xlUp).Row).Value
        ListBox1.List = tbl
    End With
End Sub


resultat

demo.gif


les deux version en pièces jointes
 

Pièces jointes

  • RECH BL V1.0 patricktoulon.xlsm
    22.3 KB · Affichages: 19
  • RECH BL V2.0 avec tableau structuré patricktoulon.xlsm
    23.7 KB · Affichages: 18
Dernière édition:

cp4

XLDnaute Barbatruc
Bonjour KTM
je t'ai donné une solution simple me semble t il la dernière fois , il suffit de travailler la reconstruction du tableau sur 10 colonnes
c'est à croire que finalement tu ne retiens rien ;)

quand on veux faire une listbox intuitive avec réduction de choix par un textbox on utilise pas ROWSOURCE
car elle n'est plus modifiable après

tu resize ton tableau avec le currentregion par le end(xlup) ce qui te donne A9:J29 alors que l'on s’arrête a 21

je vire tout donc y compris tes label d’entêtes j'ajoute une listbox2 pour me faire l’entêtes dans la quelle je mettrais la ligne 9
et dans la listbox1 je mettrais le reste a partir de la ligne 10

et pour finir il serait peut être temps d'apprendre a travailler avec des tableaux structurés ça simplifie la tache
bref
VB:
Option Explicit
Option Compare Text
Dim tbl
Private Sub TextBox1_Change()
    Dim t(), i&, a&, c&
    With TextBox1
        If .Value = "" Then ListBox1.List = tbl: Exit Sub
        For i = 1 To UBound(tbl)
            If tbl(i, 10) Like .Value & "*" Then
                a = a + 1: ReDim Preserve t(1 To 10, 1 To a)
                For c = 1 To 10: t(c, a) = tbl(i, c): Next
            End If
        Next
        If a > 0 Then ListBox1.List = Application.Transpose(t) Else ListBox1.Clear
    End With
End Sub

Private Sub UserForm_Initialize()
    With Sheets("List")
        entetes.Column = Application.Transpose(.[A9].Resize(1, 10).Value)
        tbl = .Range("A10:J" & .Range("A" & Rows.Count).End(xlUp).Row).Value
        ListBox1.List = tbl
    End With
End Sub
resultat

Regarde la pièce jointe 1125389

les deux version en pièces jointes
Bonjour @KTM , @patricktoulon ,

@patricktoulon : Il y a un truc qui ne va pas lorsqu'il y a qu'une seule ligne (transposition)
1640158015542.png
 

patricktoulon

XLDnaute Barbatruc
Bonjour @ChTi160
a priori aucuns cas mais perso je préfère travailler avec un tableau dans le bon sens
car si il doit y avoir des modif dans le tableaux c'est plus compliqué le .column je ne l'utilise que pour le cas ou il n'y a qu'une ligne restante dans la recherche
c'est ma façon de travailler (me simplifier la tache pour les étapes suivantes)
mais pour un simple listing ta version simplifié fonctionne
le clear par contre est caduque car quand tu utilise . list ou .column tu remet la liste complete a jour
et tu oublie que si pas de correspondance T est vide donc erreur
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
@ChTi160
pour bien comprendre ce que j'ai fait
il y a 4 options dans mes modèles
  1. il y a des correspondances la liste se met a jour par .list
  2. il n'y a qu'une seule correspondance la list se met a jour par .column
  3. le textbox devient vide alors la liste complète
  4. le textbox contient quelque chose mais pas de correspondances alors la liste reste vide
 

patricktoulon

XLDnaute Barbatruc
re
@ChTi160
ton écriture simplifiée avec les 4 options
VB:
Private Sub TextBox1_Change()
    Dim t(), i&, a&, c&
    With TextBox1
        If .Value = "" Then ListBox1.List = tbl: Exit Sub
        For i = 1 To UBound(tbl)
            If tbl(i, 10) Like .Value & "*" Then
                a = a + 1: ReDim Preserve t(1 To 10, 1 To a)
                For c = 1 To 10: t(c, a) = tbl(i, c): Next
            End If
        Next
        If a > 0 Then
            ListBox1.Column = t
        Else
            ListBox1.Clear
        End If
    End With
End Sub
A + je pars en inter ;)
 

Discussions similaires