vba 下拉多选

方法一：有效性验证下拉多选

• 建立下拉单选：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 下拉添加序号