怎么样删除电脑下拉列表(自动去重复的下拉菜单，厉害了)

我们今天聊的内容是单元格的数据有效性（2010版本后更名为数据验证），在EH论坛上，星光经常碰到网友提问下面酱紫的问题：

如何创建去除重复项后的下拉列表？

举个小栗子。

如下图所示，D列是一些人名，含有重复项。

现在需要根据D列的人名，在表格的A列创建去除重复人名后的数据验证下拉列表。

动画效果：

代码如下：

PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)

IfIntersect([a:a],Target)IsNothingThenExitSub

'如果选择的单元格不存在于A列，则退出。A列是设置数据验证的区域

IfTarget.Rows.Count>1ThenExitSub'不允许选择多行

Dimarr,brr,i&,j&,k&,s

DimdAsObject

Setd=CreateObject("scripting.dictionary")'后期字典

arr=Range("d1:d"&Cells(Rows.Count,"d").End(xlUp).Row)'数据来源列

IfNotIsArray(arr)ThenExitSub

'如果不存在数据源选项，则arr非数组，那么退出程序

Fori=2ToUBound(arr)

'D1是标题，从第2行开始遍历数据源，将人名装入字典

Ifarr(i,1)<> "" Then d(arr(i, 1)) = ""

Next

s=Join(d.keys,",")

WithTarget.Validation

.Delete'删掉旧的

.AddType:=xlValidateList,AlertStyle:=xlValidAlertStop,_

Operator:=xlBetween,Formula1:=s'S为数据验证的序列来源

EndWith

Application.SendKeys"%{down}"

'SendKeys发出快捷键atl+↓直接弹出数据验证下拉列表

Setd=Nothing'释放字典

EndSub

小贴士：

1，代码需要粘贴在相关工作表标签所对应的VBE窗口中。

2，代码使用了Worksheet_SelectionChange事件，当鼠标点击A列单元格时，系统自动运行该段代码。可以通过修改Intersect([a:a],Target)中的[a:a]，设置为其它目标区域。

3，代码使用了Application.SendKeys"%{down}"语句，其意思是键盘输入快捷键alt+↓，该快捷键可能会和电脑的其它热键冲突，该语句并不是必须的，因此部分亲们可以注释掉它。

图文作者：看见星光