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 Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([f5:f1000], Target) Is Nothing And Target.Count = 1 Then
Set f = Sheets("matériel")
Set d = CreateObject("Scripting.Dictionary")
' d("demande") = ""
For Each c In f.Range("a2:a" & f.[a65000].End(xlUp).Row): d(c.Value) = "": Next c
Target.Validation.Delete
Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([f5:f1000], Target) Is Nothing And Target.Count = 1 Then
If Target <> "" Then
Set f = Sheets("matériel")
Set d = CreateObject("Scripting.Dictionary")
d("demande") = ""
For Each c In f.Range("a2:a" & f.[a65000].End(xlUp).Row)
If c.Value = Target Then d(c.Offset(, 1)) = ""
Next c
If d.Count > 0 Then
Target.Offset(, 1).Validation.Delete
Target.Offset(, 1).Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
a = d.keys: Target.Offset(, 1) = a(0)
If d.Count > 1 Then Target.Offset(, 1).Select: SendKeys "%{down}"
Else
Application.EnableEvents = False
Target = ""
Target.Offset(, 1) = ""
Target.Offset(, 1).Validation.Delete
Application.EnableEvents = True
End If
End If
End If
End Sub |
Partager