Excel 实现下拉多选功能

1. 开启宏
2. 创建 sheet 级别的 vb 脚本
3. 将下面代码写入

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim watchRange As Range
    Dim newVal As String, oldVal As String
    Dim items() As String
    Dim i As Long, result As String

    ' 多选所在列：根据模板实际列号调整
    Set watchRange = Intersect(Target, Me.Range("D:D"))
    If watchRange Is Nothing Or Target.CountLarge > 1 Then Exit Sub

    On Error GoTo ExitHandler
    Application.EnableEvents = False

    newVal = Target.Value          ' 用户当前输入/选择
    Application.Undo
    oldVal = Target.Value          ' 原来的值（逗号分隔）

    ' 用户手动清空：直接置空返回
    If Len(newVal) = 0 Then
        Target.Value = ""
        GoTo ExitHandler
    End If

    ' 原来没有任何内容：直接写入新值
    If Len(oldVal) = 0 Then
        Target.Value = newVal
        GoTo ExitHandler
    End If

    ' 拆分旧值，去掉重复项
    items = Split(oldVal, ",")
    result = ""
    For i = LBound(items) To UBound(items)
        items(i) = Trim$(items(i))
        If Len(items(i)) > 0 _
           And StrComp(items(i), newVal, vbTextCompare) <> 0 _
           And InStr(1, "," & result & ",", "," & items(i) & ",", vbTextCompare) = 0 Then
            result = result & IIf(Len(result) = 0, "", ",") & items(i)
        End If
    Next i

    ' 若新值不在旧值里，则追加；若已存在，相当于反选，直接不追加
    If InStr(1, "," & oldVal & ",", "," & newVal & ",", vbTextCompare) = 0 Then
        result = result & IIf(Len(result) = 0, "", ",") & newVal
    End If

    Target.Value = result

ExitHandler:
    Application.EnableEvents = True
End Sub

这个脚本可以实现 选择，清除，反选 操作