comment filtrer une listbox au fur et à mesure des lettre du textbox

[dindin]

bonjour
le forum
j'ai une listbox qui sert à, afficher une base .
comment puis-je la filtrer depuis un textbox au fur et à mesure que je tape de lettre (colonne des noms )
aussi les dates .
merci d'avance
voir pc jointe

 

[job75]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Bonjour le fil, le forum,

Avec le filtre automatique c'est très rapide, de l'ordre du 1/10ème de seconde sur 60000 lignes :

Private Sub TextBox1_Change()
Application.ScreenUpdating = False
On Error Resume Next
Me.ShowAllData
With Range("A2:O" & Range("A" & Rows.Count).End(xlUp).Row)
  If TextBox1 <> "" Then .AutoFilter 2, TextBox1 & "*"
  If TextBox2 <> "" Then .AutoFilter 14, "*" & TextBox2 & "*"
End With
End Sub

Du coup j'utilise la même méthode pour l'UserForm :

Private Sub TextBox1_Change()
On Error Resume Next
With Sheets("bd").[A1].CurrentRegion
  .Parent.ShowAllData
  If TextBox1 <> "" Then .AutoFilter 2, TextBox1 & "*"
  If TextBox14 <> "" Then .AutoFilter 14, "*" & TextBox14 & "*"
  .Copy Feuil2.[A1] 'vers la feuille auxiliaire
  ListBox1.Clear
  With Feuil2.[A1].CurrentRegion
    ListBox1.List = .Offset(1).Resize(.Rows.Count - 1).Value
    .Clear 'RAZ
  End With
  .Parent.ShowAllData
End With
End Sub

Fichier joints.

Edit : évidemment le format spécial "Téléphone" n'est pas copié dans la ListBox...

Bonne journée.

 

[job75]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Message annulé.

 

[job75]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Re,

J'ai tenté de mettre les colonnes 5 7 8 de la ListBox aux formats Code Postal et téléphone :

'-----
  With Feuil2.[A1].CurrentRegion
    ListBox1.List = .Offset(1).Resize(.Rows.Count - 1).Value
    Dim f1$, f2$, i&
    f1 = "00000" 'format Code Postal
    f2 = "00\ 00\ 00\ 00\ 00" 'format Téléphone
    For i = 0 To ListBox1.ListCount - 1
      ListBox1.List(i, 4) = Format(ListBox1.List(i, 4), f1)
      ListBox1.List(i, 6) = Format(ListBox1.List(i, 6), f2)
      ListBox1.List(i, 7) = Format(ListBox1.List(i, 7), f2)
    Next
    .Clear 'RAZ
  End With

Sur 60000 lignes cela prend 80 secondes...

Moralité : mettre tous les chiffres et séparateurs "en dur" dans les 3 colonnes du tableau source.

A+

 

[BOISGONTIER]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Bonsoir,

Essai avec pilotage du Filtre Auto par un formulaire avec:

-ComboBox intuitif pour les noms
-ComboBox pour les dates
-Récup du résultat dans une autre feuille



JB

 

[Dranreb]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Bonsoir.
Pour afficher toute la base quand rien n'est choisi écrire ainsi la CL.Change :

Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
If NbrLgn = 0 Then If Complet Then ListBox1.Clear Else ListBox1.List = CL.PlgTablo.Resize(, 15).Value
End Sub

Ou alors comme ça, si on veut pouvoir retrouver, par une autre procédure, dans TLgn un numéro de ligne d'origine dans CL.PlgTablo, comme quand la liste est filtrée :

Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
Dim Lignes() As Long
If NbrLgn = 0 Then
   If Complet Then
      ListBox1.Clear
   Else: InitTbLong Lignes, CL.PlgTablo.Rows.Count
      CL_Résultat Lignes: End If: End If
End Sub

 

[dindin]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

merci à vous tous.... pour toutes ces propositions .... mon but c est apres filtrage ,pouvoir afficher toutes les infos d une reservation ds un autre formulaire avec text box et combo et les modifier si besoin .

 

[dindin]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

merci à vous tous.... pour toutes ces propositions .... mon but c est apres filtrage ,pouvoir afficher toutes les infos d une reservation ds un autre formulaire avec text box et combo et les modifier si besoin .

 

[BOISGONTIER]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Bonjour,

-Avec ComboBox intuitif pour le nom (frapper les premières lettres). Les noms commençant par ces lettres apparaissent au fur et à mesure de la frappe des caractères.
-Cliquer sur la ligne choisie dans le ListBox
-Valider

http://boisgontierjacques.free.fr/fichiers/Formulaire/ListBoxInutuitifModif.xls



Cette discussion commence à ressembler à ça



JB

 

[Dranreb]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Bonjour.

À vrai dire, je ne vois pas l'intérêt d'un autre UserForm ni de la ListBox. Moi j'aurais mis un Contrôle pour chaque colonne, ComboBox si elle fait partie d'une combinaison unique formant identification de la ligne ou même si l'on veut simplement pouvoir effectuer une recherche dessus, TextBox sinon. Des boutons Ajouter/Modifier, Annuler/Effacer/Quitter, Supprimer.

 

[dindin]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

l idee de mettre tout sur un seul form, je trouve bien, garder le list box est imperatif , seulement la propisition des combo liés est formidable , car elle m a permis de rajouter des combos pour filtrer chaque colonne. niveau presentation rien a dire, je trouve .
je regarde tout ca .......
merci

 

[dindin]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

d apres mes essais le form avec listbox affiche une erreur si la base ne contient aucune reservation , c est un peu logique ,car on filtre pas une base vide. seulelment pour 2016 je serai obligé de faire une copie et de la vider, peut on afficher un message qui remplacera l erreur qui dit la base est vide , veuillez rajouter une nouvelle reservation .......

 

[job75]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Bonjour dindin, Bernard, JB,

Vous avez parlé d'un autre formulaire alors le voici dans ce fichier (2).

Il permet de modifier le 1er formulaire ainsi que la feuille "bd".

Edit : il manquait un Val().

A+

 

[job75]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

Re,

Avec ce fichier (3) on peut aussi ajouter ou supprimer des lignes, dans le 1er formulaire et dans la feuille.

Edit : j'ai transformé la base en tableau Excel, il se met en forme automatiquement quand on ajoute des lignes.

A+

 

[dindin]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox

je viens d'apporter qq modif sur le dernier fichier posté par BOISGONTIER en remplaçant 4 textbox par des combo
pour faciliter la siasie si modification des données .
j'arrive pas à poster le fichier il fait plus que 2500 ko .
voilà le code entier après modif

[CODE]
Option Compare Text
Dim f, bd(), Cbx1(), Cbx2()

Private Sub TextBox18_Change()
Dim C, firstAddress
If Len(TextBox18.Text) = 5 Then
ComboVille.Clear
With Feuil2.Range("A2:A" & Feuil2.[A65536].End(3).Row)
Set C = .Find(TextBox18, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
ComboVille.AddItem C.Offset(0, 1)
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
ComboVille.SetFocus
End If
End Sub

Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  If f.[B2] = "" Then Exit Sub
  bd = f.Range("a2:p" & [a65000].End(xlUp).Row).Value
  Me.CbxPaiement.List = Array("ESP", "CHQ", "CB")
   Me.ComboPoids.List = Array("40 Kg", "45 Kg", "50 Kg")
   Me.ComboPrix.List = Array("170.00 €", "200.00 €", "220.00 €")
    Me.ComboJAbbat.List = Array("J 1", "J 2", "J 3")
  For i = 1 To UBound(bd, 2) - 1
   temp = temp & f.Columns(i).Width * 0.98 & ";"
   Me("label" & i) = f.Cells(1, i)
   Me("label" & i + 19) = f.Cells(1, i)
   Me("label" & i).Top = Me.ListBox1.Top - 20
   largeur = largeur + f.Columns(i).Width * 1.05
  Next
  Me.ListBox1.ColumnWidths = temp: Me.Width = largeur + 10
  Me.ListBox1.List = bd
  '--
  Set d1 = CreateObject("scripting.dictionary")
  For i = 1 To UBound(bd)
    If bd(i, 2) <> "" Then d1(bd(i, 2)) = ""
  Next i
  Cbx1 = d1.keys
  Call tri(Cbx1, LBound(Cbx1), UBound(Cbx1))
  Me.ComboBox1.List = Cbx1
  Me.ComboBox1.SetFocus
  '--
  Set d1 = CreateObject("scripting.dictionary")
  For i = 1 To UBound(bd)
    If bd(i, 14) <> "" Then d1(bd(i, 14)) = CDate(bd(i, 14))
  Next i
  Cbx2 = d1.items
  Call tri(Cbx2, LBound(Cbx2), UBound(Cbx2))
  Me.ComboBox2.List = Cbx2
End Sub
Private Sub ComboBox1_Change()
     Set d1 = CreateObject("scripting.dictionary")
     Set d2 = CreateObject("scripting.dictionary")
     raz
     clé1 = UCase(Me.ComboBox1) & "*": clé2 = Me.ComboBox2 & "*"
     Dim b()
     n = 0: ncol = UBound(bd, 2)
     For i = LBound(bd) To UBound(bd)
       If UCase(bd(i, 2)) Like clé1 And UCase(bd(i, 14)) Like clé2 Then
         n = n + 1: ReDim Preserve b(1 To ncol, 1 To n)
         For k = 1 To ncol: b(k, n) = bd(i, k): Next
         If bd(i, 2) <> "" Then d1(bd(i, 2)) = ""
         If bd(i, 14) <> "" Then d2(bd(i, 14)) = CDate(bd(i, 14))
       End If
      Next i
      If n > 0 Then
        ReDim Preserve b(1 To ncol, 1 To n + 1)
        Me.ListBox1.List = Application.Transpose(b)
        Me.ListBox1.RemoveItem n
        Cbx1 = d1.keys
        Call tri(Cbx1, LBound(Cbx1), UBound(Cbx1))
        Me.ComboBox1.List = Cbx1
        If ActiveControl.Name = "ComboBox1" Then Me.ComboBox1.DropDown
        Cbx2 = d2.items
        Call tri(Cbx2, LBound(Cbx2), UBound(Cbx2))
        Me.ComboBox2.List = Cbx2
      End If
End Sub
Private Sub ComboBox2_Change()
  ComboBox1_Change
End Sub
Sub tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call tri(a, g, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub
Private Sub B_recup_Click()
  nbcol = UBound(bd, 2)
  Sheets("Result").Cells.ClearContents
  Sheets("Result").Range("A2").Resize(Me.ListBox1.ListCount, nbcol) = Me.ListBox1.List
  For i = 1 To nbcol - 1
    Sheets("Result").Cells(1, i) = Me("label" & i).Caption
    Sheets("Result").Cells(1, i).Font.Bold = True
  Next
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = Cbx1
  Me.ComboBox1.DropDown
End Sub
Private Sub B_raz_Click()
 Me.ComboBox2 = ""
End Sub
Private Sub B_raz1_Click()
  Me.ComboBox1 = ""
End Sub
Private Sub ListBox1_Click()
  ligne = ListBox1.ListIndex
  For i = 0 To 4
      Me("textbox" & i + 14) = ListBox1.List(ligne, i)
  Next i
  For i = 6 To 7
      Me("textbox" & i + 14) = ListBox1.List(ligne, i)
  Next i
  For i = 12 To UBound(bd, 2) - 2
      Me("textbox" & i + 14) = ListBox1.List(ligne, i)
  Next i

  Me.ComboVille = ListBox1.List(ligne, 5)
  Me.ComboPoids = ListBox1.List(ligne, 8)
  Me.ComboPrix = ListBox1.List(ligne, 9)
    Me.CbxPaiement = ListBox1.List(ligne, 10)
      Me.ComboJAbbat = ListBox1.List(ligne, 11)
End Sub
Private Sub B_valider_Click()
 reservation = Me.TextBox14
 Set ligne = f.[A:A].Find(what:=reservation)
 If Not ligne Is Nothing Then
   lig = ligne.Row
   For Each k In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15)
     tmp = Me("textbox" & k + 13)
     If IsNumeric(tmp) Then
        f.Cells(lig, k) = CDbl(tmp)
     Else
        f.Cells(lig, k) = tmp
     End If
   Next
   
    f.Cells(lig, 6) = Me.ComboVille
    f.Cells(lig, 9) = Me.ComboPoids
    f.Cells(lig, 10) = Me.ComboPrix
    f.Cells(lig, 11) = Me.CbxPaiement
    f.Cells(lig, 12) = Me.ComboJAbbat
   ligne = ListBox1.ListIndex
   bd = f.Range("a2:p" & [a65000].End(xlUp).Row).Value
   ComboBox1_Change
   Me.ListBox1.ListIndex = ligne
 End If
End Sub
Sub raz()
 For Each k In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15)
    Me("textbox" & k + 13) = ""
 Next
End Sub

[/CODE]
mon souci maintenant , ce que j'arrive pas à supprimer les 4 textbox ( N° 19/22/23/24 ) que j'ai remplacé par des combos .
j'arrive à afficher les infos , les modifier et à les enregistrer .
il m'affiche une erreur

 

[dindin]

Re : comment filtrer une listbox au fur et à mesure des lettre du textbox