Saisie dans Combobox

Version imprimable

25/01/2019, 21h33
Siramane

1 pièce(s) jointe(s)

Saisie dans Combobox

Bonjour tout le monde

J'avais une question concernant les items dans une combobox, quand on commence à écrire dans la combobox.

Par exemple j'ai une combobox qui contient les noms complets des usagers.

Exemple de nom et prénom : Anaud Cédric

Quand je commence à écrire correctement le nom d'une personne (ex: An…) la combobox filtre automatiquement comme ci-dessous :

Pièce jointe 444607

Mais si je commence par écrire le prénom de la personne en premier (ex : Céd…), la combobox ne réagit pas.

Y a t'il un moyen que la combobox puisse filtrer peu importe les caractères qu'on rentre?

Merci beaucoup!

2 pièce(s) jointe(s)

Bonjour,

Ca s'appelle la recherche intuitive. Faire une recherche dans Google (recherche intuitive excel combobox)

Exemple en PJ

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim a()
Private Sub UserForm_Initialize()
  a = Application.Transpose([liste])
  Me.ComboBox1.List = a
End Sub
 
Private Sub ComboBox1_Change()
 If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
   Me.ComboBox1.List = Filter(a, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
  Else
    ActiveCell = Application.Proper(Me.ComboBox1)
    Unload Me
  End If
End Sub

Autre exemple:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim a()
Private Sub UserForm_Initialize()
  Set f = Sheets("feuil1")
  a = Application.Transpose(f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value)
  Me.Combobox1.List = a
End Sub
 
Private Sub ComboBox1_Change()
 If Me.Combobox1.ListIndex = -1 Then
   Me.Combobox1.List = Filter(a, Me.Combobox1.Text, True, vbTextCompare)
   Me.Combobox1.DropDown
  End If
End Sub
 
Private Sub ComboBox1_Click()
  Me.TextBox1 = Me.Combobox1
End Sub

Boisgontier

bonjour jacques
j'ajoute l'evenement dropbuttonclick dans le quel je remet la liste complete

on a ainsi les deux mode d'exploitation de la combobox (recherche intuitive/selection manuelle dans liste complete )
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Dim tablo() Private Sub ComboBox1_DropButtonClick() With ComboBox1: .List = tablo: .DropDown: End With End Sub ' Private Sub UserForm_Initialize() tablo = Application.Transpose(Range("A1:A10").Value) Me.ComboBox1.List = tablo End Sub ' Private Sub ComboBox1_Change() With ComboBox1 If .ListIndex = -1 And IsError(Application.Match(.Value, tablo, 0)) Then .List = Filter(tablo, .Text, True, vbTextCompare) .DropDown End If End With End Sub
EDIT:
j'ajouterais aussi que sauf erreur de ma part!!! le test iserror sur match n'est pas necessaire dans le sens ou le le match demande l'expression complete pour matcher
donc tant qu'une expression tapée ne correspond pas a un element entier de l'array le match sera toujours en error (il es donc inutile )
et comme le matchentry est en mode 2 !!! le test listindex est inutile aussi (j'ai testé)
ca n'empeche pas le mode selection manuelle dans liste complete(j'ai testé!!)puisque la selection va donner un seul item dans le tableau filtré
et comme je remet la liste complete avec le dropbuttonclick j'ai toujours ma liste complete dispo dans la combo

je te propose de tester toi meme ;)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Dim tablo() ' 'je remet la liste complete au dropbuttonclik pour une eventuelle selection manuelle Private Sub ComboBox1_DropButtonClick() With ComboBox1: .List = tablo:: End With End Sub ' 'remplissage de la variable tablo 'injection de la variable tableau dans la combobox Private Sub UserForm_Initialize() tablo = Application.Transpose(Range("A1:A10").Value) With Me.ComboBox1: .MatchEntry = 2: .List = tablo: End With End Sub ' 'on filtre quand le value de la combobox change Private Sub ComboBox1_Change() With ComboBox1 .List = Filter(tablo, .Text, True, vbTextCompare) .DropDown End With End Sub

merci

Ça marche parfaitement.

Merci les amis!;)

Comment faire pour éliminer les doublons dans les items de la combobox

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 
 
Private Sub UserForm_Initialize()
 
Sheets("DEMANDES").Select
 
    dossier = Application.Transpose(Range("AK2:AK65536").Value)
    Me.cbo_dossier.List = dossier
 
 
cbo_dossier.Value = ""
INDEX_DEMANDE.Value = ""
 
 
 
End Sub
 
Private Sub cbo_dossier_DropButtonClick()
 
    With cbo_dossier: .List = dossier: .DropDown: End With
 
End Sub
 
 
Private Sub cbo_dossier_Change()
 
 
  With cbo_dossier
        If .ListIndex = -1 And IsError(Application.Match(.Value, dossier, 0)) Then
            .List = Filter(dossier, .Text, True, vbTextCompare)
            .DropDown
        End If
  End With
 
end sub

Mon ancien code qui me permettait de le faire est celui ci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
 
Private Sub UserForm_Initialize()
 
 
Dim I As Integer
For I = 2 To Sheets("DEMANDES").Range("AK65536").End(xlUp).Row
  cbo_dossier = Sheets("DEMANDES").Range("AK" & I)
  If cbo_dossier.ListIndex = -1 Then cbo_dossier.AddItem Sheets("DEMANDES").Range("AK" & I)
Next I
 
cbo_dossier.Value = ""
 
 
 
End Sub

Merci encore!

1 pièce(s) jointe(s)

bonsoir siramane

fait moi plaisir teste ca

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
'model patricktoulon
Dim tablo()
'
'je remet la liste complete au dropbuttonclik pour une eventuelle selection manuelle
Private Sub ComboBox1_DropButtonClick()
    With ComboBox1: .List = tablo:: End With
End Sub
'
'remplissage de la variable tablo
'injection de la variable tableau dans la combobox
Private Sub UserForm_Initialize()
    tablo = Application.Transpose(Range("A1:A15").Value)
    With Me.ComboBox1: .MatchEntry = 2: .List = tablo: End With
End Sub
'
'on filtre quand le value de la combobox change
Private Sub ComboBox1_Change()
    Dim dico As Object, tabl, i&
    With ComboBox1
        If .ListIndex = -1 Then
            Set dico = CreateObject("scripting.dictionary")
            tabl = Filter(tablo, .Text, True, vbTextCompare)
            For i = 0 To UBound(tabl): dico(tabl(i)) = "": Next
            .List = dico.keys
        End If
        .DropDown
    End With
End Sub

Pièce jointe 444941

;)

27/01/2019, 20h32
Siramane

merci

Franchement Patrick,

Je ne saurai comment te remercier.

Ça marche! Impeccable;)