下拉菜单 字典去重

每天学一点。

下拉菜单 字典去重

蓝桥玄霜

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Intersect([B3], Target) Is Nothing Then Exit Sub
   
3.     Dim arr, brr, i&, j&, k&, s
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     arr = Sheets("数据").Range("B1:B" & Sheets("数据").Cells(Sheets("数据").Rows.Count, "B").End(xlUp).Row)
   
7.     If Not IsArray(arr) Then Exit Sub
   
8.     For i = 2 To UBound(arr)
   
9.         If arr(i, 1) <> "" Then d(arr(i, 1)) = ""
   
10.     Next
    
11.     s = Join(d.keys, ",")
    
12.     With Target.Validation
    
13.         .Delete
    
14.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=s
    
15.         .ShowError = False
    
16.     End With
    
17.     Set d = Nothing
    
18. End Sub
    

复制代码