XL 2016 Affiche resultat d'une recherche dans listbox

KTM

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

Fichiers joints

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+
 

ChTi160

XLDnaute Barbatruc
Bonjour KTM
Bonjour le Fil ,le Forum
bien vague "Je voudrais faire des recherches dans ma table" peux tu préciser ?
merci
jean marie
 

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+
 

Fichiers joints

Dernière édition:

BOISGONTIER

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

Fichiers joints

Dernière édition:

ChTi160

XLDnaute Barbatruc
Bonjour KTM
Bonjour le Fil , le Forum
JB
au post #6
il manque la procédure "TriMultiCol" je pense !
Ça peut être Utile ! Lol
Merci
jean marie
 

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+
 

Fichiers joints

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas