Excel 如何做下拉框多选？
37 个回答
更新日期：20220620，版本：4.7
详情
https://www.zhihu.com/video/1522305607286124544下载神器： Excel录入神器4.7
最新更新：20220427-更新支持关键词、首字母混合查找
更多细节： https://www.zhihu.com/question/32285088/answer/2454320318
Excel下拉多选4.0版本https://www.zhihu.com/video/1502765295005167616首发原文： 附件及详情
最近我们开发了一个一键生成多级联动的，也是提高数据录入效率的工具！
Excel多级联动，一键生成！https://www.zhihu.com/video/1502765809441517568首发原文： 附件及详情
更新日期：20220421
更新日期：20211222
更新内容如下：高效录入、标签管理更新V3.0版本
工具获取，使用说明，详见下方视频
https://www.zhihu.com/video/1457129617064243200原文及附件获取： 附件获取方式
更新日期：20211210
添加最新版本视频使用说明~
更新日期：20211008
本次更新内容：
效果预览
更新内容及附件详情： 内容及附件
更新日期：20211125
最近好好总结了一下，所有菜单相关知识：
为自己带盐的 - 对应的视频教程链接
自己写了一下，重复的，只要undo即可，不用那么麻烦
'作者：Excel办公实战-小易
'日期：2019-8-12
'功能：下拉框多选
'******************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count <> 1 Then End
If Intersect(Target, Columns(3)).Cells.Count = 0 Then End
Application.EnableEvents = False
newdata = Target.Value
Application.Undo
olddata = Target.Value
If newdata <> "" Then
If olddata <> "" Then
Target.Value = olddata & "," & newdata
If InStr(olddata, newdata) > 0 Then
Target.Value = olddata
Else
Target.Value = olddata & "," & newdata
End If
Else
Target = newdata
End If
End If
Application.EnableEvents = True
End Sub很多朋友想先要实现可以多选，还要能删除的功能，所以我抽点时间写了一下：
看效果应该满足条件，VBA+窗体控件实现！
下面是详细图文教程！
感谢jeremy的代码，可以用。
不过在Office 2016上每次编辑都特别卡顿，最后发现是 SpecialCells 函数的锅（貌似10年前外网就有人反应给微软了，居然至今未解决）。
为此改写了代码，用新的方法来判断，操作起来如丝般顺滑；并顺便优化了整体的逻辑，更方便大家自定义连接符和设置哪几列需要多选。
使用方法：
- 复制下面全部代码；
- 在需要应用单选框的sheet页面的页面名称标签（底部）上右键并选择 查看代码；
- 在弹出的窗体内直接粘贴代码并保存即可；
- 如有需要可在开始几行自定义连接符和哪几列需要多选，代码内搜索“自定义”即可。
详细技术可参考：
https://www.contextures.com/excel-data-validation-multiple.html
PS：数据安全请自己负责，这里仅提供方法。
Private Sub Worksheet_Change(ByVal Target As Range)
'''''''''''''''''''''''''''''''''' begin of MultiSelect ''''''''''''''''''''''''''''''''''
' 允许excel内置的下拉框（数据校验形式实现的）多选
Dim colArr As Variant
Dim connector As String
Dim oldVal As String
Dim newVal As String
colArr = Array(1, 3) ' 自定义第几列要多选，1就是A列，3就是C列，有需要继续加，注意代码里的逗号要用英文输入法
connector = "," ' 自定义多个选项之间的连接符，可改为想要的，若要用回车作为连接符，则直接用后面这句替代 connector= Chr(10)
If Target.Count > 1 Then GoTo exitHandler
On Error GoTo exitHandler
'SpecialCells being slow seems to be excel 2010+'s bug from the beginning. So MS.
If Target.Validation.Type <= 0 Or WorksheetFunction.Match(Target.Column, colArr, 0) <= 0 Then
If Err.Number <> 0 Then GoTo exitHandler
End If
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Or newVal = "" Then ' 若改之前或改制后单元格内容为空，则不执行代码
'do nothing
ElseIf InStr(1, newVal, connector) Then ' 若新内容内有连接符，说明不是通过下拉操作的，则不执行代码
'do nothing
ElseIf newVal = oldVal Then ' 只剩唯一一个选项且重复选择时，不执行代码
'do nothing
ElseIf InStr(1, oldVal, newVal) <> 0 Then ' 剩余多个时重复选择视同删除
If InStr(1, oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then ' 最后一个是选项重复
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - Len(connector))
Else ' 非最后一个选项重复的时候处理逗号
Target.Value = Replace(oldVal, newVal & connector, "")
End If
Else ' 非重复选项就视同增加选项
Target.Value = oldVal & connector & newVal
End If
exitHandler:
Application.EnableEvents = True
'''''''''''''''''''''''''''''''''' end of MultiSelect ''''''''''''''''''''''''''''''''''
End Sub
这篇文章中，是我见过的最简单最易用的实现方式。
在讲解多级下拉框之前，雷哥给大家讲解下Excel中一级下拉列表，二级下拉列表，三级下拉框
1.一级下拉列表——数据有效性
案例1 ：如图所示，A列数据需要通过下拉框写出雷哥最喜欢的菜名。 菜名list已经显示在E列中。
step1：选中A列数据，在功能区的【数据】选项卡中单击【数据验证】按钮
step2：在打卡的【数据验证】对话框中，选择【序列】，数据来源选择E2:E5单元格，单击确定按钮。
可以发现，A列通过下拉框就可以实现数据的输入啦~
案例2：教育类型需要通过下拉框输入
step1：选中D列数据，单击【数据】——【数据验证】——【序列】；
step2：手动输入“ 全日制, 非全日制" 后，单击确定即可。
D列数据输入就变为以及下拉框啦~
总结： 案例1和案例2讲解了一级下拉框实现，可以通过数据验证的方法进行实现，我们即可选择数据验证的序列的选择数据源（案例1），也可以手动输入数据（案例2）
2.二级、三级下拉列表
step1：选中二级和三级下拉列表数据源，单击【公式】——【根据所选内容创建】——勾选首行
step2：选中E列数据，单击【数据验证】——序列——输入 =indirect($D2),单击确定
可以发现，E列的数据，是受D列数据约束：
如果D列是 全日制，则E列数据显示全日制大学；如果D列是非全日制，则E列的数据显示非全日制大学。
Step3：同理，做出三级下拉框。
各位小伙伴，多级下拉框的做法，你学会了吗？
欢迎大家关注【雷哥office】同名微信公众号，经常会有免费送Excel/PPT/Word书活动~
这东西的方法很多。。啊？
data validation, combo box（developer tools）, 骚气的列了什么我不会的VBA之类。
我本人一般是不允许别人乱按的就combo box，然后序列弄到另一个tab里面隐藏起来了。不过这么弄要弄个vlookup，麻烦一点。
然后你是不是想三个下拉框，允许选择那么多品牌中的一个，然后还有一个显示这三个连起来的？如果是的话，而且用的combo box，用vlookup+concatenate。
看报告看累了，随手做着玩。
combo box大小不要在意，我做这个表并没有钱拿。。。
整理一个专辑，从简单的入门下拉列表制作到二三级联动菜单，这个专辑里有你想找到的所有方法介绍。
另推荐关注Excel表哥同名微信公众平台，可以免费下载诸多Excel办公模板！
■模板合辑 | Excel表哥的生产力提升工具下载链接↓↓↓
■历史文章页面↓↓↓
https://mp.weixin.qq.com/mp/profile_ext?action=home&__biz=MzIwMDY4MjQ3NQ==#wechat_redirect
我根据大家的回答，修改了一下代码，做到了重复选择就是取消选择的效果。可以试试。
Private Sub Worksheet_Change(ByVal Target As Range)
' Developed by Contextures Inc.
' www.contextures.com
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 7 Then '这里规定好哪一列的数据有效性是多选的，A列是第1列，依次类推，如3就是C列，7就是G列
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
If InStr(1, oldVal, newVal) <> 0 Then '重复选择视同删除
If InStr(1, oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then '最后一个选项重复
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
Else
Target.Value = Replace(oldVal, newVal & ",", "") '不是最后一个选项重复的时候处理逗号
End If
Else '不是重复选项就视同增加选项
Target.Value = oldVal & "," & newVal
' NOTE: you can use a line break,
' instead of a comma
' Target.Value = oldVal _
' & Chr(10) & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
找到一个超简单方法，只需两步，10秒搞定。
1. 先在某列利用数据有效性-建立下拉菜单表。
2. 在下拉表所打开的sheet中（如sheet1），鼠标右击下面的工作表。选择“查看代码”，就可打开VBA编辑界面。复制答案最后面的代码，并将其中一行的
If Target.Column = 3 Then
中的3修改为下来数据表所在的列数，搞定。
ta-da, we're done!
附代码（代码来源：
Excel Data Validation - Select Multiple Items）
Private Sub Worksheet_Change(ByVal Target As Range)
' Developed by Contextures Inc.
' www.contextures.com
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 3 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
' NOTE: you can use a line break,
' instead of a comma
' Target.Value = oldVal _
' & Chr(10) & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
可以通过VBA中listbox来实现，原来正好使用过，供参考：
Dim blIsSelect As Boolean '标记一下 是否刚刚选择单元格，以防单元格中有数据，执行了ListBox1_Change.
Private Sub ListBox1_Change()
If ListBox1.ListIndex = -1 Or blIsSelect = True Then Exit Sub
Dim i&, s$
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then s = s & "," & .List(i)
Next
.TopLeftCell.Offset(, -1).Value = Mid(s, 2)
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strV() As String
Dim intI As Integer, intL As Integer
ListBox1.Visible = False
If Target.Count > 1 Then Exit Sub
'1、您的性别
If Target.Row = 2 And Target.Column = 2 Then
With ListBox1
.MultiSelect = 1
.ListStyle = 1
.List = ThisWorkbook.Worksheets("筛选条件值").Range("A2:A3").Value
.Top = Target.Top
.Left = Target.Left + Target.Width
.Height = Target.Height * 5
.Width = 90
.Visible = True
End With
'将判断单元格的值，并将相关选项勾选
blIsSelect = True '标记为真'
If Trim(Target.Value) <> "" Then
strV = Split(Target.Value, ",")
For intI = 0 To UBound(strV)
For intL = 0 To ListBox1.ListCount - 1
If ListBox1.List(intL) = strV(intI) Then ListBox1.Selected(intL) = True
Next
Next
End If
blIsSelect = False '标记为假'
End If
'2、年龄
If Target.Row = 3 And Target.Column = 2 Then
With ListBox1
.MultiSelect = 1
.ListStyle = 1
.List = ThisWorkbook.Worksheets("筛选条件值").Range("B2:B5").Value
.Top = Target.Top
.Left = Target.Left + Target.Width
.Height = Target.Height * 5
.Width = 90
.Visible = True
End With
'将判断单元格的值，并将相关选项勾选
blIsSelect = True '标记为真'
If Trim(Target.Value) <> "" Then
strV = Split(Target.Value, ",")
For intI = 0 To UBound(strV)
For intL = 0 To ListBox1.ListCount - 1
If ListBox1.List(intL) = strV(intI) Then ListBox1.Selected(intL) = True
Next
Next
End If
blIsSelect = False '标记为假'
End If
'3、婚姻状况
If Target.Row = 4 And Target.Column = 2 Then
With ListBox1
.MultiSelect = 1
.ListStyle = 1
.List = ThisWorkbook.Worksheets("筛选条件值").Range("c2:c3").Value
.Top = Target.Top
.Left = Target.Left + Target.Width
.Height = Target.Height * 5
.Width = 90
.Visible = True
End With
'将判断单元格的值，并将相关选项勾选
blIsSelect = True '标记为真'
If Trim(Target.Value) <> "" Then
strV = Split(Target.Value, ",")
For intI = 0 To UBound(strV)
For intL = 0 To ListBox1.ListCount - 1
If ListBox1.List(intL) = strV(intI) Then ListBox1.Selected(intL) = True
Next
Next
End If
blIsSelect = False '标记为假'
End If
'4、最高学历
If Target.Row = 5 And Target.Column = 2 Then
With ListBox1
.MultiSelect = 1
.ListStyle = 1
.List = ThisWorkbook.Worksheets("筛选条件值").Range("D2:D5").Value
.Top = Target.Top
.Left = Target.Left + Target.Width
.Height = Target.Height * 5
.Width = 90
.Visible = True
End With
'将判断单元格的值，并将相关选项勾选
blIsSelect = True '标记为真'
If Trim(Target.Value) <> "" Then
strV = Split(Target.Value, ",")
For intI = 0 To UBound(strV)
For intL = 0 To ListBox1.ListCount - 1
If ListBox1.List(intL) = strV(intI) Then ListBox1.Selected(intL) = True
Next
Next
End If
blIsSelect = False '标记为假'
End If
End Sub另外，这种例子可以在EXCELHOME论坛搜索，比较多，里面还有可以实现标签选择式列表框的例子（比如下图），可以在根据标签实时切换下拉框内容，
帮忙搜了一下 找到了唯一感觉靠谱的一篇文章。但我看不懂，不知道是否帮到你。如下:
Excel下拉列表多选框实现
Excel提供了下拉列表的实现，但并不支持多选，后来慢慢找资料终于利用VBA编程实现了多选的问题。
首先点击视图->宏，工程资源所示：
有Microsoft Excel对象：对应的是Sheet1或Sheet2对像等;
窗体:对应的是弹出的对话框；
模块:对应的是调用某些功能的入口。
以Sheet1页单击D列为例弹出框供多选
1：
先建立宏，然后编辑，在"Microsoft Excel对象"中单击"Sheet2"的右键-》查看代码
将此代码保存：
Private Sub Worksheet_SelectionChange(ByVal Target As Range) //说明：监听sheet1发生的用户操作事件
If ActiveCell.Column = 8 And ActiveCell.Row > 1 Then //说明:当前激活列为J列，第二行以下
Call ShowFM2 //调用显示窗体宏名
End If
End Sub
2：
在工程资源-》"模块"对象 中 “插入模块”-》查看代码
保存如下代码：
Sub ShowFM()
UserForm1.Show
End Sub
3：
在工程资源->"窗体"->插入"用户窗体"
然后在"工具箱"里拖放"列表框"和"命令按钮"到窗体上
接着点击"查看代码"
将以下代码保存：
Private Sub CommandButton1_Click()
Dim Arr(), k&, i&
ReDim Arr(1 To 1)
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
k = k + 1
ReDim Preserve Arr(1 To k)
'Arr(k) = .List(i, 1)
Arr(k) = Sheet2.Range("A" & (i + 1)).Value //获取Sheet2列表中A列i+1行的值
End If
Next i
End With
'MsgBox "您选择了：" & Join(Arr, ",")
UserForm1.Hide
'Application.ActiveSheet.Range("A1").Value = Join(Arr, ",")
Application.ActiveCell.Value = Join(Arr, ",") //将值放入到当前单元格
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Initialize()
With UserForm1.ListBox1
.RowSource = "Sheet2!A1:A49" '设定源数据区域 ，下拉列表框的数据来源
.ColumnCount = 1 '设定列数
.ColumnHeads = False '设定列标题。标题为数据区域的上一行
.BoundColumn = 2
.MultiSelect = fmMultiSelectMulti '按空格键或单击鼠标以选定列表中一个条目或取消选定。
' .MultiSelect = fmMultiSelectExtended '按 Shift 并单击鼠标，或按 Shift 的同时按一个方向键，将所选条目由前一项扩展到当前项。按 Ctrl 的同时单击鼠标可选定或取消选定。
' .MultiSelect = fmMultiSelectSingle '只可选择一个条目（默认）。
End With
End Sub
-----
保存试试看，不行的话看附件
来源 http://ganliang13.iteye.com/blog/1312957
用VBA代码来做！4步教你做下拉框多选~
❶ 既然是下拉列表，那我们第一步就先来添加一个列表。
点击【开发工具】选项卡-【插入】-ActiveX 控件-列表框。
注意：是 ActiveX 控件，不是表单控件。
❷ 随手画一个列表框，大小位置随意，画完之后，再次点击【开发工具】选项卡-「设计模式」，退出「设计模式」。
「设计模式」按钮由灰色变回白色，则表明已退出。
❸ 新建工作表「data」，在 A1 单元格输入下拉选项的标题，A2 及以下的单元格输入选项内容。
❹ 回到 Sheet1 工作表，使用快捷键【Alt+F11】打开 VBA 编辑器，双击需要添加多选列表的工作表（此处是 Sheet1），然后将相关的 VBA 代码黏贴到代码窗口。
最后关闭 VBA 编辑器。
这样多选下拉列表就搞定了，接下来我们看看效果。
现在我们就可以点击单元格，打开多选下拉列表，然后通过点击列表的选项，快速输入不同的选项组合。
（VBA 代码预留了第一行是标题，因此点击第一行不会出现下拉列表。）
除了以上功能外，通过在 data 工作表中增减或修改选项，可以快速修改下拉列表的选项内容，Sheet1 工作表中的列表框会自动更新选项。
data 工作表中的 A 列对应 Sheet1 工作表中 A 列的列表框，data 工作表中的 B 列对应 Sheet1 工作表中 B 列的列表框，以此类推。
如果 data 工作表中 A 列不填写任何内容，则 Sheet1 中的对应列也不会出现多选列表框。
因此，可以根据自己的需求，在任意列添加多选列表。
✦【注意事项】
❶ 如果你发现 Excel 没有【开发工具】选项卡，可以单击【文件】-「选项」-「自定义功能区」-「主选项卡」，找到「开发工具」并勾选。
❷ 设置列表选项的工作表（案例中的 data 工作表）必须命名为 data。
❸ 添加了 VBA 代码的文件，建议将文件格式保存为"启用宏的工作簿(*.xlsm)"，这样下次打开时，VBA 的功能才能正常使用。
代码获取方法：
作者：阿芙酱
来源：知乎
转载链接：
在之前的经验介绍中介绍了Excel设置下拉框，但excel自身的下拉框设置智能设置为单选，如何实现下拉框多选？要实现多项选择，从功能上要解决：
- 可以实现多选，用“，”或者“、”或者空格连接；
- 可以较便捷的取消选择。
更多的word教程以及电脑办公office教程，可以点击下方pdf文档获取：
方法/步骤
1/5
要设置多选需要使用vb命令，需在Excel中通过“文件”>“选项”>“自定义功能区”>“开发工具”>“确定”设置使用开发工具。
2/5
通过“开发工具”>“Visual Basic”或右键选项卡>“查看代码”打开VB编辑器。
3/5
打开编辑器后将代码复制到工作区里即可实现多选功能。
4/5
由于项目初期，对选项设置的还不完善，经常有需要填入选项外的内容的情况，为此建议在“数据”>“数据验证”>“出错警告”中选择样式为“警告”，当输入不在选项范围内的内容时可以继续输入。
5/5
启用代码后，需要保存成.xlsm格式才可保存代码，需将文件另存为启用宏的工作簿。
注意事项
WPS需要安装插件才可使用宏命令，可通过互联网搜索易得。网上有很多相关的代码，经实践，没有找到完全合适好用的，最终采用了一种代码，并进行了修改，最终实现上述两点功能。代码如下：
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
'让数据有效性选择 可以多选,重复选
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Then
Else
If newVal = "" Then
Else
If InStr(newVal, oldVal) > 0 Then
Target.Value = newVal
Else
If InStr(oldVal, newVal) > 0 Then
Target.Value = newVal
Else
Target.Value = oldVal _
& "、 " & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
人在江湖，生不由己。人在职场，Excel 必备。
人在江湖，生不由己。人在职场，Excel 必备。
为了帮助更多人快速掌握职场必备技能 Excel，猴子老师写了一个 《职场 Excel 教程》，能帮助你解决，分别整理成了视频课版和文字版。
视频课取 10w+文字版精华，长达 6 小时，课上猴子老师亲自教大家基础的 Excel 数据分析功能，覆盖 99% 职场中的应用场景，同时还将结合互联网大厂一线真实业务案例讲解数据分析常用模型架构逻辑，帮大家构建数据分析基础思维框架。为感谢大家支持，猴子老师还整理了 excel 自学手册 1-6 部全版本作为到课福利免费发放，想玩转 Excel+数据分析的来：
想看文字版的，点击下方链接即可跳转：
《职场 Excel》
第 1 章：快速处理数据
1.如何快速选中数据
2.如何查找和替换数据？
3.Excel 的数据类型
4.如何进行数据验证？
5.如何删除重复数据？
6.项目实战：7 道面试题
第 2 章：数据可视化入门
1.如何制作图表？
2.如何设置图表属性？
3.设计图表的原则是什么？
4.如何看懂图表？
第 3 章：数据可视化进阶
1.管理项目工具甘特图如何制作？
2.如何制作组合图？
3.如何制作创意图表？
4.数据条：让表格一目了然
5.突出显示重点数据？
6.如何让数据高亮显示?
第 4 章：用函数让工作高效
1.字符串截取函数
2.多表查询：vlookup 函数
3.查找函数：index+match 组合
4.求和函数
第 5 章：Excel 函数进阶
1.如何实现排名？
2.自动判断：if 函数
3.摆脱手工计数：countif 函数
4.日期问题：dateif 函数来搞定
第 6 章：Excel 数据分析
1.如何分析常用的指标？
2.财务数据如何分析？
3.Excel 预测分析：时间数据
4.Excel 预测分析：留存分析
5.一套面试题
以上文字版内容将会不定时更新，等不及建议看视频课版。内容不仅是最新的，而且还有在线直播答疑，1v1 解决你遇到的难题。如果刚接触数据分析，还是建议看视频课了解下数据分析一些基本的模型结构+架构逻辑，以及 Excel 的数据分析功能+同时还有专业老师手把手带你实战演练，有需要的朋友点击下方链接即可：
拿的别人的改了下，加了再次选择就删除已存在项的功能
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
'让数据有效性选择 可以多选,重复选
Dim rngDV As Range
Dim oldVal As String
Dim tVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
tVal = ""
If oldVal = "" Then
Else
If newVal = "" Then
Else
If InStr(1, "," & oldVal & ",", "," & newVal & ",") <> 0 Then '已存在
tVal = Replace(Replace(oldVal & ",", newVal & ",", ""), ",,", ",")
If InStr(Len(tVal), tVal, ",") <> 0 Then '判断最后一位是否逗号，是则不要最后一位
tVal = Left(tVal, Len(tVal) - 1)
End If
Target.Value = tVal
Else
Target.Value = oldVal & "," & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
这个我会！
全部分享出来！！
直接上干货！！！
【1】选中相应的单元格，点击数据--数据验证--数据验证
【2】选择序列-输入数据来源，用英文输入下的逗号隔开
【3】在表名如sheet1处右键，选择查看代码
【4】进入后复制代码到新建的文件里即空白区域（代码附在最后）
【5】点击保存会有提示跳出来，点击否
【6】点击否之后会跳出保存窗口，选择启用宏的工作簿格式保存
【7】点击确定，跳出如图提示，再点击确定
【8】依次选中a，b，c就可以实现多选的功能
代码：
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
'让数据有效性选择 可以多选,重复选
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Then
Else
If newVal = "" Then
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
这就是今天分享的干货。
关注我获得更多Excel干货，让你不再加班！
拜托拜托拜托点个赞，谢谢您。
作者：SAP机器人
来源：微信公众号
转载链接： https://mp.weixin.qq.com/s/RXOL