XL 2010 Problème code liste déroulante semi automatique

pezz44

XLDnaute Nouveau
Bonjour à tous,

j'ai besoin de votre aide, je souhaite réaliser une liste semi automatique mais j'ai plusieurs erreurs que je n'arrive pas à modifier , j'ai trouvé le code ci dessous sur internet.
La base de donnée de ma liste déroulante se trouve dans un onglet appelé : Données TDB
La colonne ou je souhaite mettre en place la liste déroulante est : D4 à D …...

j'ai commencé à modifier dans le code ( je vous met à cote du texte avec une flèche ce que j'avais mis )

Mais mon soucis c'est que cela ne fonctionne pas j'ai 2 erreurs les ligne de code ci dessous :
- If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
- For Each c In a

Je vous remercie par avance pour votre aide :)

Dim a(), mémo, f
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set f = Sheets("bd") ---> Données TDB
Set zSaisie = Range("A2:A16") ---> ( D4:D1000)
If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
If mémo <> "" Then If IsError(Application.Match(Range(mémo), a, 0)) Then Range(mémo) = ""
a = Application.Transpose(f.Range("a2: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
mémo = Target.Address
Else
Me.ComboBox1.Visible = False
End If
End Sub
Private Sub ComboBox1_Change()
If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
Set d1 = CreateObject("Scripting.Dictionary")
tmp = UCase(Me.ComboBox1) & "*"
For Each c In a
If UCase(c) Like tmp Then d1(c) = ""
Next c
Me.ComboBox1.List = d1.keys
Me.ComboBox1.DropDown
End If
ActiveCell.Value = Me.ComboBox1
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.List = Application.Transpose(f.Range("a2:a" & f.[A65000].End(xlUp).Row))
Me.ComboBox1.DropDown
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If IsError(Application.Match(ActiveCell, a, 0)) Then ActiveCell = ""
ActiveCell.Offset(1).Select
End If
End Sub
 

Statistiques des forums

Discussions
315 093
Messages
2 116 137
Membres
112 668
dernier inscrit
foyoman