Excel 制作数据有效性下拉菜单后，选项里如何筛选不重复值-vba程序

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Column > 2 Or Target.Row < 3 Then Exit Sub
   
4. Dim d, i&, Myr&, Arr, r%, Arr1(), cp$, ks&, js&, j&
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. Set d1 = CreateObject("Scripting.Dictionary")
   
7. Myr = Sheet1.[a65536].End(xlUp).Row
   
8. Arr = Sheet1.Range("a3:c" & Myr)
   
9. For i = 1 To UBound(Arr)
   
10.     If Arr(i, 1) <> "" Then
    
11.         x = Arr(i, 1) & "|" & Arr(i, 2)
    
12.         d(Arr(i, 1)) = d(Arr(i, 1)) & i & ","
    
13.         d1(x) = Arr(i, 3)
    
14.     End If
    
15. Next
    
16. k = d.keys
    
17. If Target.Column = 1 Then
    
18.     With Target.Validation
    
19.         .Delete
    
20.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
21.         Operator:=xlBetween, Formula1:=Join(d.keys, ",")
    
22.     End With
    
23.     Target.Offset(0, 1) = ""
    
24. ElseIf Target.Column = 2 And Target.Offset(0, -1) <> "" Then
    
25.     t = d(Target.Offset(0, -1).Value)
    
26.     t = Left(t, Len(t) - 1)
    
27.     If InStr(t, ",") Then
    
28.         aa = Split(t, ",")
    
29.         For j = 0 To UBound(aa)
    
30.             cp = cp & Arr(aa(j), 2) & ","
    
31.         Next
    
32.         cp = Left(cp, Len(cp) - 1)
    
33.         With Target.Validation
    
34.             .Delete
    
35.             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
36.                 Operator:=xlBetween, Formula1:=cp
    
37.         End With
    
38.     Else
    
39.         With Target.Validation
    
40.             .Delete
    
41.         End With
    
42.         Target = Arr(t, 2)
    
43.     End If
    
44. End If
    
45. Set d = Nothing
    
46. End Sub
    

复制代码