XL 2016 Liste déroulante avec mots clefs contenant

[Benjamin_FKF]

Bonjour,
J'ai besoin de créer une liste déroulante pour chaque cellule d'une colonne.
Le nombre de références contenues dans la liste étant important , il faudrait pouvoir taper un mot clef qui affiche les références possibles et renvoi la référence souhaitée par un double clic.

J'ai parcouru la forum à la recherche d'une solution mais impossible d'arriver au résultat souhaité.

Ci-joint le format du fichier.

Pour résumé , il faut que l'on puisse sélectionner dans les cellules de la colonne D , un établissement contenu dans l'onglet BD (par recherche de mots clefs)

Merci pour voter aide !

Bien cordialement,

 

[don_pets]

Hello,

tu peux aussi passer par un combobox et un tableau (avec la gestion de nom)avec un truc du genre :

Private Sub ComboBox1_GotFocus()
  ComboBox1.List = Sheets("BD").Range("IciTonNomdeColonne").Value
End Sub

Private Sub ComboBox1_Change()
 If Me.ComboBox1 <> "" Then
 [e3] = "" 
   Set d1 = CreateObject("Scripting.Dictionary")
   clé = UCase(Me.ComboBox1) & "*"
   For Each c In Sheets("BD").Range("IciTonNomdeColonne").Value
     If UCase(c) Like clé Then d1(c) = ""
   Next c
   Me.ComboBox1.List = d1.keys
   Me.ComboBox1.DropDown
   [e3] = Me.ComboBox1
 End If
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 ComboBox1.List = Sheets("BD").Range("IciTonNomdeColonne").Value
 Me.ComboBox1.DropDown
End Sub

À adapter bien entendu,

Enjoy

 

[job75]

Bonjour Benjamin_FKF, bienvenue sur XLD, salut don_pets,

Voyez le fichier joint et ces macros dans le code de la feuille "Détail" :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ComboBox1
    .Visible = False
    .ListFillRange = ""
    If Intersect(ActiveCell, Range("D3:D" & Rows.Count)) Is Nothing Then Exit Sub
    .Left = ActiveCell.Left
    .Top = ActiveCell.Top
    .Width = ActiveCell.Width
    .LinkedCell = ActiveCell.Address
    .Visible = True
    .Activate
End With
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim F As Worksheet, crit$
Set F = Sheets("BD")
crit = "*" & ComboBox1 & "*"
F.[A1].CurrentRegion.AutoFilter 1, crit
With Sheets("Liste") 'feuille auxiliaire (à masquer)
    .Cells.Delete 'RAZ
    F.[A1].CurrentRegion.Copy .[A1]
    With .[A1].CurrentRegion
        If .Rows.Count > 1 Then ComboBox1.ListFillRange = .Offset(1).Resize(Rows.Count - 1).Address(External:=True) _
            Else ComboBox1.ListFillRange = ""
    End With
End With
F.[A1].CurrentRegion.AutoFilter
ComboBox1.DropDown 'déroule la liste
End Sub

A+

 

[Benjamin_FKF]

Bonjour Don_pets et Job75.

C'est exactement ce qu'il me fallait !!
Merci beaucoup pour votre aide et votre rapidité de réponse

Bien cordialement ,

 

[BOISGONTIER]

Bonjour,

Saisie intuitive avec Filter()

Dim a(), f
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("bd")
  Set zSaisie = Range("D3:D100")  'zone de saisie
  If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
    a = Application.Transpose(f.Range("a1:a" & f.[A65000].End(xlUp).Row))
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub

Private Sub ComboBox1_Change()
   Me.ComboBox1.List = Filter(a, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
   ActiveCell.Value = Me.ComboBox1
End Sub

Boisgontier

 

[don_pets]

Salut boisgontier, je n'avais pas encore eu le temps de te remercier et de te féliciter pour la qualité de ton partage sur ton site. C'est inestimable. Merci