double saisie intuitive

bernardrustrel

XLDnaute Occasionnel
Bonjour
le fichier joint présente sur la Textbox1 une saisie intuitive d'un nom d'acteur. Or j'aimerais pouvoir, si cela est possible , dans la même Textbox1 saisir de la même façon un deuxième acteur.
Je détaille, après la premier acteur je positionne une "," et un espace la Textbox1 se présente alors ainsi
"Alain Chabat, "espace""
C'est la que ça se complique , car il faudrait que la Listbox1 me permette de choisir un deuxième acteur issu de la liste initiale.
Ce devrai donner une fois ce dernier choisi:"Alain Chabat, Marion Cotillard"
J'avoue me mélanger sacrement les pinceaux dans la chronologie de sollicitation de la Listbox1.
Aussi l'un vous saurait il venir à mon aide, je l'en remercie déjà grandement
Cordialement,Bernard
 

Fichiers joints

BOISGONTIER

XLDnaute Barbatruc
Bonjour,

Code:
Option Compare Text
Dim f, Choix(), d1, d2
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   Set Rng = f.Range("a2:a" & f.[A65000].End(xlUp).Row)
   Choix = Application.Transpose(Rng)
   Me.ListBox1.List = Choix
   Set d1 = CreateObject("scripting.dictionary")
   Set d2 = CreateObject("scripting.dictionary")
End Sub

Private Sub TextBox1_Change()
   d1.RemoveAll
   For i = 1 To UBound(Choix)
     If Choix(i) Like Me.TextBox1 & "*" Then d1(Choix(i)) = ""
   Next i
   Me.ListBox1.List = Fusion
End Sub

Private Sub TextBox2_Change()
   d2.RemoveAll
   For i = 1 To UBound(Choix)
     If Choix(i) Like Me.TextBox2 & "*" Then d2(Choix(i)) = ""
   Next i
   Me.ListBox1.List = Fusion
End Sub

Function Fusion()
Set d3 = CreateObject("Scripting.Dictionary")
For Each c In d1.keys: d3(c) = "": Next c
For Each c In d2.keys: d3(c) = "": Next c
Fusion = d3.keys
End Function
jb
 

Fichiers joints

Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Plusieurs recherches avec un seul TextBox

Code:
Option Compare Text
Dim f, Choix(), d1
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   Set Rng = f.Range("a2:a" & f.[A65000].End(xlUp).Row)
   Choix = Application.Transpose(Rng)
   Me.ListBox1.List = Choix
End Sub

Private Sub TextBox1_Change()
   Set d1 = CreateObject("scripting.dictionary")
   mots = Split(Trim(Me.TextBox1), ",")
   For Each m In mots
     mots2 = Split(Trim(m), " ")
     Tbl = Choix
     For i = LBound(mots2) To UBound(mots2)
       Tbl = Filter(Tbl, mots2(i), True, vbTextCompare)
     Next i
     For i = LBound(Tbl) To UBound(Tbl): d1(Tbl(i)) = "": Next i
   Next m
   Me.ListBox1.List = d1.keys
End Sub
http://boisgontierjacques.free.fr/fichiers/Formulaire/RechercheIntuitiveMultiMotsOU.xls

jb
 

Fichiers joints

Dernière édition:

bernardrustrel

XLDnaute Occasionnel
Bonsoir
Merci pour votre promptitude quant à répondre à ma demande.
J'avoue avoir omis un détail, en effet j'ai ajouté:
Private Sub ListBox1_Click()
TextBox1 = Me.ListBox1
End Sub
Ce qui me permet de valider mon premier choix. Ensuite afin de passer au second acteur je n'arrive pas à ce que le premier reste dans la textbox1 .
Je décris pas à pas
1/ saisie des premiers caractères du 1er acteur (ce qui donne: Al)
2/validation du 1er acteur par click dans listbox1 (ce qui donne: Al Pacino)
3/saisie virgule et espace dans textbox1 (ce qui donne: Al Pacino, )
4/saisie des premiers caractères du 2eme acteur (ce qui donne: Al Pacino, Cl)
5/validation du 2eme acteur par click dans listbox1 (ce qui donne: Al Pacino, Clint Esatwood)
le plus dur pour moi est que le passage du 4 au 5

Merci encore à vous.
Bernard
 

bernardrustrel

XLDnaute Occasionnel
Bonjour JB
J'ai adapte le fichier joint à mon besoin, cela a l'air de fonctionner jusqu'à (pour l'avoir tester) 3 acteurs.
Je ne pense pas que ces quelques lignes rajoutées soient des plus élégantes mais en attendant de faire mieux.
Merci encore grandement
Bernard
 

Fichiers joints

bernardrustrel

XLDnaute Occasionnel
Re Bonjour
Je suppose que je dois me tromper quant à la validation (par click dans listbox1) du nom choisi, afin qu'il se positionne correctement dans la textbox1.
Merci encore
 

Discussions similaires


Haut Bas