XL 2016 Affiche resultat d'une recherche dans listbox

[KTM]

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

 

[danielco]

Bonjour,

Cool, tout est déjà affiché dans la listbox. Problème résolu ?

Daniel

 

[job75]

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]

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]

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 :

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+

 

[BOISGONTIER]

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

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

 

[BOISGONTIER]

Autre version avec pgm générique

Permet une recherche multi-mots multi-colonnes

Boisgontier

 

[ChTi160]

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]

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 :

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 :

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+

 

[salimalg]

Est-il possible de changer la largeur de la colonne

 

[job75]

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+

 

[salimalg]

Bonjour JOB75
La colonne 3 et la colonne 2 ont la même largeur

 

[job75]

Propriété ColumnCount => 3.

Propriété ColumnWidths => 70 pt;200 pt;550 pt.

Propriété Width => 850.

 

[salimalg]

MERCI job 75

 

[salimalg]

Propriété ColumnCount => 3.

Propriété ColumnWidths => 70 pt;200 pt;550 pt.

Propriété Width => 850.

pouvez-vous imprimer
TextBox1 ???
Merci d'avance