filtre textbox comme dans Itune ......

[kevenpom]

Bonjour a tous,
voilà j'ai un textbox avec une listbox quand je tape mon texte dans ma textbox il recherche dans ma feuille colonne A.

Le problème ses que j'aimerait que ma recherche se fasse a partir de n'importe ou dans la chaine de caractère..... et non pas seulement a partir de la gauche...
exemple comme dans Itune quand ont tape "park lin"
bien il nous ressort tout le "linkin park"
pour l'instant si ma chaine de caractère est "salut 1234"
je doit absolument taper dans ma textbox "sal" pour qu'il me ressorte mon "salut 1234"
alors que j'aimerai pouvoir taper "12 sa" pour qu'il me sorte ma chaine "salut 1234".

Voici mon code ....
Merci encore pour votre support.

Private Sub TextBoxRechCode_Change()
ListBox1.Clear
ListBox2.Clear
N = 0
Recherche = TextBoxRechCode.Value
Ligne = Worksheets("vente").Range("a" & "65536").End(xlUp).Row
Set Plage = Worksheets("vente").Range("a" & "1:" & "a" & Ligne)
With Plage
Set C = .Find(Recherche)
If Not C Is Nothing Then
Adresse = C.Address
Do
    If UCase(Recherche) = UCase(Left(C, Len(Recherche))) Then
        ListBox1.AddItem C.Offset(0, 0), N
        ListBox1.List(N, 0) = C
        ListBox1.List(N, 1) = C.Offset(0, 1)
        ListBox1.List(N, 2) = C.Offset(0, 2)
        ListBox1.List(N, 3) = C.Offset(0, 3)
        ListBox1.List(N, 4) = C.Offset(0, 4)
        N = N + 1
    End If
    Set C = .FindNext(C)
    Loop While Not C Is Nothing And C.Address <> Adresse
    End If
End With
For x = 1 To 8
 Controls("Textbox" & x) = ""
Next x
If TextBoxRechCode = "" Then ListBox1.List = t

 

[JNP]

Re : filtre textbox comme dans Itune ......

Re ,

est t'il possible que quand j'efface mon texte dans TextBoxRechCode
que mes 2 listbox ne se rénisialise pas pour afficher toute les possibilités....
ou meme si j'efface un caractère de ma textebox mes 2 listebox ne se rénisialise pas pour afficher les possibilités....il reste comme il était ...

Quand tu effaces, ta textbox vaut "", donc vu la première ligne

If TextBoxRechCode = "" Or Right(TextBoxRechCode, 1) = " " Then Exit Sub

le code n'est pas exécuté et les listboxs restent intactes ???
Pour que l'effacement ne soit pas actif, déclare une variable en début de module (en dehors des subs)

Dim MaLongueur As Integer

et rajoute ce test au début du Change

If MaLongueur < Len(TextBoxRechCode) Then Exit Sub Else MaLongueur = Len(TextBoxRechCode)

ça devrait fonctionner .
A +

 

[JNP]

Re : filtre textbox comme dans Itune ......

Re ,

en fait avec le code que tu donne cela ne recherche plus quelle que soit les lettres que l'on entre dans la case recherche, plus aucune réponse ne parvient...

Peux-tu être plus explicite ?
A +

 

[chacmhaal]

Re : filtre textbox comme dans Itune ......

en fait désolé j'ai pris pour moi une reponse qui ne m'était pas destinée par contre pour selectionner un resultat de ma listbox, qui me renvoie à la ligne correspondante de mon fichier client j'ai essayé mais je tourne en rond je suis perdu je n'y arrive pas du tout...

 

[JNP]

Re : filtre textbox comme dans Itune ......

Re ,
Je comprends mieux . C'est ça de s'incruster sur un fil ... Mais bon .
Pour simplifier, coupe cette ligne dans Change et remets là hors sub, en dessous de Dim I As Integer

Dim C As Range, Adresse  As String, N As Integer

Le but est ne ne pas redéclarer à chaque fois toutes les variables .
Puis ajoute le code

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For I = 0 To ListBox1.ListCount
If ListBox1.Selected(I) Then Exit For
Next I
With Range("B:B")
Set C = .Find(ListBox1.List(I, 1), LookAt:=xlWhole)
Adresse = C.Address
N = 0
Do
If C.Offset(0, 1) = ListBox1.List(I, 2) Then
Rows(C.Row).Select
Unload Me
Exit Sub
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse
End With
End Sub

Ça devrait le faire (je suis parti du principe qu'une raison sociale ET une ville définissait un client unique).
Bonne journée
PS : J'ai oublié de préciser : en double cliquant sur la ligne.

 

[chacmhaal]

Re : filtre textbox comme dans Itune ......

en fait moi je n'ai pas de ligne Dim I As Integer

Private Sub RaisonSociale_Change()


Dim C As Range, Adresse As String, N As Integer

With Range("B:B")
Set C = .Find(RaisonSociale, LookAt:=xlPart)
If C Is Nothing Then Exit Sub
ListBox1.Clear
Adresse = C.Address
N = 0
Do
If C.Row <> 2 Then
ListBox1.AddItem C.Offset(0, -1), N
For i = 0 To 8
ListBox1.List(N, i + 1) = C.Offset(0, i)
Next i
N = N + 1
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse
End With
End Sub

 

[JNP]

Re : filtre textbox comme dans Itune ......

Re ,
L'intégralité du code de l'USF :

Option Explicit
Dim I As Integer
Dim C As Range, Adresse As String, N As Integer
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For I = 0 To ListBox1.ListCount
If ListBox1.Selected(I) Then Exit For
Next I
With Range("B:B")
Set C = .Find(ListBox1.List(I, 1), LookAt:=xlWhole)
Adresse = C.Address
N = 0
Do
If C.Offset(0, 1) = ListBox1.List(I, 2) Then
Rows(C.Row).Select
Unload Me
Exit Sub
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse
End With
End Sub
 
Private Sub RaisonSociale_Change()
With Range("B:B")
Set C = .Find(RaisonSociale, LookAt:=xlPart)
If C Is Nothing Then Exit Sub
ListBox1.Clear
Adresse = C.Address
N = 0
Do
If C.Row <> 2 Then
ListBox1.AddItem C.Offset(0, -1), N
For I = 0 To 8
ListBox1.List(N, I + 1) = C.Offset(0, I)
Next I
N = N + 1
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse
End With
End Sub
 
Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 10
End Sub

A +

 

[chacmhaal]

Re : filtre textbox comme dans Itune ......

Un GRAND MERCI, sa marche nickel, exactement ce qu'il me fallai du coup je l'ai placé au sommet de ma base de donnée et j'appel ma recherche par un bouton un grand merci, il faut maintenant que je reprenne le code ligne par ligne pour le comprendre entièrement encore merci