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

3）保存自定义宏配置

Ctrl+s会弹出警告窗口，选择No

• Yes 不会保存VBA宏配置，默认的 .xlsx不支持保存自定义宏
• No 另存为其他类型个文件，.xlsm 后缀为支持宏的文件

四、配置office支持自定义宏

• 不配置启用宏，重新打开xlsm文件，之前设置的宏是不会生效的

文件 --> 选项 --> 信任中心 --> 信任中心配置 --> 宏配置 --> 启用VBA宏

五、查看xlsm