VBA常用小代码103：实现去重且自动显示列表的数据有效性
每一次都在孤单徘徊中坚强，每一次就算很受伤也不闪泪光，我知道我一直有双隐形的翅膀，带我飞飞过绝望…………
听首歌，都好好的……
我们今天聊的内容是单元格的数据有效性（2010版本后更名为数据验证），在EH论坛上，星光经常碰到网友提问下面酱紫的问题：
如何创建去除重复项后的下拉列表？
举个小栗子。
如下图所示，D列是一些人名，含有重复项。
现在需要根据D列的人名，在表格的A列创建去除重复人名后的数据验证下拉列表。
动画效果：
代码如下：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect([a:a], Target) Is Nothing Then Exit Sub
'如果选择的单元格不存在于A列，则退出。A列是设置数据验证的区域
If Target.Rows.Count > 1 Then Exit Sub '不允许选择多行
Dim arr, brr, i&, j&, k&, s
Dim d As Object
Set d = CreateObject('scripting.dictionary') '后期字典
arr = Range('d1:d' & Cells(Rows.Count, 'd').End(xlUp).Row) '数据来源列
If Not IsArray(arr) Then Exit Sub
'如果不存在数据源选项，则arr非数组，那么退出程序
For i = 2 To UBound(arr)
'D1是标题，从第2行开始遍历数据源，将人名装入字典
If arr(i, 1) <> '' Then d(arr(i, 1)) = ''
Next
s = Join(d.keys, ',')
With Target.Validation
.Delete'删掉旧的
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=s 'S为数据验证的序列来源
End With
Application.SendKeys '%{down}'
'SendKeys发出快捷键atl ↓直接弹出数据验证下拉列表
Set d = Nothing '释放字典
End Sub
小贴士：
1，代码需要粘贴在相关工作表标签所对应的VBE窗口中。
2，代码使用了Worksheet_SelectionChange事件，当鼠标点击A列单元格时，系统自动运行该段代码。可以通过修改Intersect([a:a], Target)中的[a:a]，设置为其它目标区域。
3，代码使用了Application.SendKeys '%{down}'语句，其意思是键盘输入快捷键alt ↓，该快捷键可能会和电脑的其它热键冲突，该语句并不是必须的，因此部分亲们可以注释掉它。
4，握爪~晚安啦~
一码不扫，
可以扫天下？
ExcelHome
VBA编程学习与实践
上一篇
甲肝
最新文章
-
揭秘：伤寒汗出病解的方式有哪些
6分钟前 -
洗髓修炼中的：找病、攻病、翻病、愈病！
21分钟前 -
（原创）颤证的经方治疗案。。。
27分钟前 -
中医教你：看指甲上的月牙诊病
39分钟前 -
中药方论（24）
42分钟前 -
仅一味中药就可以降血糖 ，一味中药的单药方！
44分钟前 -
解郁安神颗粒：抑郁症、焦虑症都是因为肝的疏泄功能出现了失调
55分钟前 -
有一种痛苦叫牙疼，有种止疼药叫艾灸！收藏起来，以备不时之需！
1小时前
有话要说...