XL 2016 Affiche resultat d'une recherche dans listbox

KTM

XLDnaute Impliqué
Bonjour chers tous
Je voudrais faire des recherches dans ma table et afficher le résultat dans ma listbox
Comment procéder ? Merci
 

Pièces jointes

  • Rechercher.xlsm
    20.9 KB · Affichages: 56

job75

XLDnaute Barbatruc
Bonjour KTM, danielco,

Soit vous utilisez la méthode List pour remplir la ListBox et il suffit alors de créer le tableau VBA des résultats de la recherche.

Soit vous utilisez la méthode RowsSource et alors il faut une 2ème feuille qui récupérera par copier-coller les résultats de la recherche.

Nombreux exemples sur ce forum.

A+
 

job75

XLDnaute Barbatruc
Re, bonjour Jean-Marie,

Non ce n'est pas vague, une TextBox permet de créer le critère de recherche, voyez le fichier joint et ces macros :
VB:
Private Sub TextBox1_Change()
UserForm_Initialize
End Sub

Private Sub UserForm_Initialize()
Dim critere$, P As Range, ncol%, tablo, i&, test As Boolean, j%, n&, resu()
critere = "*" & LCase(TextBox1) & "*" 'minuscules pour ignorer la casse
Set P = [A1].CurrentRegion
Set P = P.Resize(P.Rows.Count + 1) 'au moins 2 lignes
ncol = P.Columns.Count
ListBox2.ColumnCount = ncol
tablo = P 'matrice, plus rapide
For i = 2 To UBound(tablo) - 1
    test = False
    For j = 1 To ncol
        Select Case j
            Case 2: If Format(tablo(i, j), "mmm-yy") Like critere Then test = True: Exit For
            Case 11: If Format(tablo(i, j), "dd-mmm-yy") Like critere Then test = True: Exit For
            Case Else: If LCase(tablo(i, j)) Like critere Then test = True: Exit For
        End Select
    Next j
    If test Then
        n = n + 1
        ReDim Preserve resu(1 To ncol, 1 To n) 'tableau transposé
        For j = 1 To ncol
            resu(j, n) = Switch(j = 2, Format(tablo(i, j), "mmm-yy"), j = 11, Format(tablo(i, j), "dd-mmm-yy"), True, tablo(i, j))
        Next j
    End If
Next i
If n = 0 Then ListBox2.Clear: Exit Sub
'---transposition et remplissage de la ListBox---
ReDim tablo(1 To n, 1 To ncol)
For i = 1 To n
    For j = 1 To ncol
        tablo(i, j) = resu(j, i)
Next j, i
ListBox2.List = tablo
End Sub
Ici c'est donc la méthode List que j'utilise.

Edit : dans le fichier (1) la casse est ignorée, dans le fichier (1 bis) la casse est respectée.

A+
 

Pièces jointes

  • Rechercher(1).xlsm
    25.4 KB · Affichages: 48
  • Rechercher(1 bis).xlsm
    25.5 KB · Affichages: 36
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Cf PJ

-Les largeurs de colonne sont calculées automatiquement
-Les entêtes sont affichés
-On choisit les colonnes affichées
-L'ordre du listbox est choisi

VB:
Option Compare Text
Dim f, TblBD, ColVisu(), NbCol
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set Rng = f.Range("A2:Z" & f.[A65000].End(xlUp).Row)
  TblBD = Rng.Value ' rapidité
  ColVisu = Array(1, 2, 3, 5, 6, 7, 8, 10, 11) ' Colonnes à visualiser (adapter)
  NbCol = UBound(ColVisu) + 1
  ReDim TblTitreListBox(1 To UBound(ColVisu) + 1)
  TitreBD = Application.Transpose(Rng.Offset(-1).Resize(1).Value)
  For i = LBound(ColVisu) To UBound(ColVisu)
    TblTitreListBox(i + 1) = TitreBD(ColVisu(i), 1)
  Next i
  Me.ComboTri.List = TblTitreListBox
  '---- Contenu ListBox initial
  EnteteListBox
  Affiche
End Sub

Private Sub TextBox1_Change()
  Affiche
End Sub

Sub Affiche()
  temp = "*" & Me.TextBox1 & "*"
  Dim Tbl(): n = 0
  For i = 1 To UBound(TblBD)
    If TblBD(i, 11) Like temp Then
      n = n + 1: ReDim Preserve Tbl(1 To NbCol, 1 To n)
      c = 0
      For Each k In ColVisu
        c = c + 1: Tbl(c, n) = TblBD(i, k)
      Next k
    End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

Sub EnteteListBox()
  x = Me.ListBox1.Left + 8
  y = Me.ListBox1.Top - 12
  For Each k In ColVisu
    Set Lab = Me.Controls.Add("Forms.Label.1")
    Lab.Caption = f.Cells(1, k)
    Lab.Top = y
    Lab.Left = x
    x = x + f.Columns(k).Width * 1#
    temp = temp & f.Columns(k).Width * 1# & ";"
  Next
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
  Me.ListBox1.ColumnWidths = temp
End Sub

Private Sub ComboTri_click()
  Dim Tbl()
  colTri = Me.ComboTri.ListIndex
  Tbl = Me.ListBox1.List
  TriMultiCol Tbl, LBound(Tbl), UBound(Tbl), colTri
  Me.ListBox1.List = Tbl
End Sub

Sub TriMultiCol(a, gauc, droi, colTri) ' Quick sort
  ref = a((gauc + droi) \ 2, colTri)
  g = gauc: d = droi
  Do
    Do While a(g, colTri) < ref: g = g + 1: Loop
    Do While ref < a(d, colTri): d = d - 1: Loop
    If g <= d Then
       For c = LBound(a, 2) To UBound(a, 2)
          temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then TriMultiCol a, g, droi, colTri
   If gauc < d Then TriMultiCol a, gauc, d, colTri
End Sub

Boisgontier
 

Pièces jointes

  • ListBox.xls
    63.5 KB · Affichages: 54
Dernière édition:

job75

XLDnaute Barbatruc
Re, salut JB,

Les fichiers du post #5 utilisent des tableaux VBA et la méthode List pour remplir la ListBox.

Ces fichiers (2) et (2 bis) utilisent le filtre avancé et la méthode RowSource :
VB:
Private Sub TextBox1_Change()
UserForm_Initialize
End Sub

Private Sub UserForm_Initialize()
Dim P As Range
ThisWorkbook.Names.Add "Critere", "*" & LCase(TextBox1) & "*" 'nom défini, minuscules pour ignorer la casse
Set P = [A1].CurrentRegion
ListBox2.ColumnCount = P.Columns.Count
P(2, P.Columns.Count + 2) = "=Test(Critere," & P.Rows(2).Address(0, 0) & ")" 'voir la fonction Test dans Module1
With Feuil2 'CodeName
    .Cells.Clear 'RAZ
    P.AdvancedFilter xlFilterCopy, P(1, P.Columns.Count + 2).Resize(2), .Range(P.Rows(1).Address) 'filtre avancé
    P(2, P.Columns.Count + 2) = ""
    If .UsedRange.Rows.Count = 1 Then
        ListBox2.RowSource = ""
    Else
        .Rows(1).Delete
        ListBox2.RowSource = .UsedRange.Address(External:=True)
    End If
End With
End Sub
Avec la fonction VBA dans Module1 :
VB:
Function Test(critere$, plage As Range)
Dim j%
For j = 1 To plage.Count
    Select Case j
        Case 2: If Format(plage(j), "mmm-yy") Like critere Then Test = True: Exit Function
        Case 11: If Format(plage(j), "dd-mmm-yy") Like critere Then Test = True: Exit Function
        Case Else: If LCase(plage(j)) Like critere Then Test = True: Exit Function
    End Select
Next
End Function
Pour comparer les 2 méthodes j'ai recopié le tableau source de 7 lignes sur 56 000 lignes :

- avec la méthode List l'UserForm s'ouvre en 10 secondes

- avec la méthode RowSource l'UserForm s'ouvre en 1,4 seconde.

A+
 

Pièces jointes

  • Rechercher(2).xlsm
    27.9 KB · Affichages: 41
  • Rechercher(2 bis).xlsm
    27.7 KB · Affichages: 55

salimalg

XLDnaute Nouveau
Est-il possible de changer la largeur de la colonne
بدون عنوان.png
 

job75

XLDnaute Barbatruc
Bonjour salimalg, bienvenue sur XLD,

Pour un 1er message ce n'est pas très brillant :

- vous n'avez pas lu la Charte du forum, on dit bonjour en arrivant

- joignez votre fichier, allégé et sans données confidentielles

- quelles largeurs voulez-vous donner aux colonnes de la ListBox ?

A+
 

Discussions similaires

Réponses
21
Affichages
1 K
  • Résolu(e)
Microsoft 365 Code de tri
Réponses
22
Affichages
206
Réponses
25
Affichages
603