方法一:有效性验证下拉多选
- 建立下拉单选:https://jingyan.baidu.com/article/1876c85255d929890a13767d.html
- 设置多选代码:
Sub Worksheet_Change(ByVal Target As Range)
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
' 为了确保用户在Excel操作时只选中了单个单元格
If Target.Count > 1 Then Exit Sub
' 当加上On Error Resume Next语句后,如果后面的程序出现"运行时错误"时,会继续运行,不中断。
On Error Resume Next
' 定位含有验证条件的单元格
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
' Intersect函数 返回两个或多个单元格重叠的部分 例子:Intersect(Range('a1:d5'), Range('c4:g9'))
If Not Application.Intersect(Target, xRng) Is Nothing Then
xValue2 = Target.Value
' 事件响应,假如工作表发生改变,Undo,撤销该表
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
' InStr函数
' 第1个参数1代表从xValue1的第一个位置开始查找;
' 第2个参数 要搜索的字符串;
' 第3个参数 搜索到的字符串
' & 字符串连接符
If xValue1 = xValue2 Or InStr(1, xValue1, "," & xValue2) Or InStr(1, xValue1, xValue2 & ",") Then
Target.Value = xValue1
Else
Target.Value = xValue1 & "," & xValue2
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
注:上面的代码无法反选;
- 参考1 https://blog.csdn.net/weixin_43564923/article/details/87193978 【亲测可用】(可以反选的代码)
- 参考2 https://blog.csdn.net/T_amo/article/details/107039058 【亲测可用】
方法二:控件下拉多选
-
参考1 https://itnoteshare.com/note/404/publicNoteDetail.htm 【亲测可用】
-
参考2 https://zhuanlan.zhihu.com/p/55353022 【亲测可用】
-
参考3 http://www.exceloffice.net/archives/3477 【亲测可用】
-
20210625 下拉添加序号