Excel实现下拉菜单多选

注意事项

需要用到VBA宏编程
WPS需要商业版才能启用VBA编程，office破解版（仅供学习）可以使用
本文所有操作均在office2021上进行

一、（已有可忽略）打开office开发者工具

"文件“ --> "选项" --> "自定义功能区" --> 勾上"开发者工具"

二、设置表格可选项

建议单独将所有可选项放在一个sheet中

三、设置单元格下拉菜单多选

1、选择需要设置的单元格

我这里选择A2:A7

2、先设置下拉菜单

数据 --> 数据校验 --> 数据校验

允许的数据选择"列表"，来源选择第二个sheet中对应的选项

3、设置允许多选

1）右键工作表，查看源码

2）编辑VB代码

注意：

修改If Target.Column = 1 Then行，这里表示哪一列支持下拉框多选，改成实际的列
- 例如1表示A列
- If Target.Column = 12 Or Target.Column = 13 Then 表示12列和13列的下拉框都支持多选
'开头的行为注释行，不会执行，直接忽略即可

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 = 1 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