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

dindin

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

Pièces jointes

  • Gest abbat.xlsm
    44.1 KB · Affichages: 64

job75

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

Code:
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 :

Code:
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.
 

Pièces jointes

  • Gest abbat avec filtre automatique(1).xlsm
    40.9 KB · Affichages: 49
  • Gest abbat avec filtre automatique et Userform(1).xlsm
    32 KB · Affichages: 56
Dernière édition:

job75

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

Code:
'-----
  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

XLDnaute Barbatruc
Repose en paix
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

SansTitre.png

JB
 

Pièces jointes

  • FormInutuitifFiltreAuto.zip
    779.7 KB · Affichages: 65
  • SansTitre.png
    SansTitre.png
    39.5 KB · Affichages: 41
Dernière édition:

Dranreb

XLDnaute Barbatruc
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 :
VB:
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 :
VB:
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
 
Dernière édition:

dindin

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

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

XLDnaute Barbatruc
Repose en paix
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

SansTitre.jpg

Cette discussion commence à ressembler à ça

projet-informatique.jpg

JB
 

Pièces jointes

  • ListBoxInutuitifModif.xls
    97.5 KB · Affichages: 74
  • SansTitre.jpg
    SansTitre.jpg
    34.6 KB · Affichages: 49
Dernière édition:

Dranreb

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

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

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

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

Pièces jointes

  • Gest abbat avec filtre automatique et Userform(2).xlsm
    38.9 KB · Affichages: 37
Dernière édition:

job75

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

Pièces jointes

  • Gest abbat avec filtre automatique et Userform(3).xlsm
    44.2 KB · Affichages: 43
Dernière édition:

dindin

XLDnaute Occasionnel
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:
[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
 

Discussions similaires

  • Résolu(e)
Microsoft 365 Code de tri
Réponses
22
Affichages
731

Statistiques des forums

Discussions
314 644
Messages
2 111 529
Membres
111 189
dernier inscrit
Laurent.