XL 2016 Liste déroulante avec mots clefs contenant

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

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

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