在excel下拉菜单中实现多复选多个功能

我们在制作excel表格模板的时候，为了控制用户的输入，会将单元格设置数据验证格式，如下图：

但数据验证只支持单选项，无法支持多选，那么，我们如何实现下拉复选框，实现多个选项勾选呢？（如下图）

实验开始：
环境：Excel 2016
支持：VBA支持库（没有安装的，需要安装哦）
第一步：准备数据源
新建一个Excel表格，sheet1创建4列表头字段，sheet2用来存放选项值，我们以“爱好”、“学习课程”为例来实现下拉复选框

第二步：调出开发工具

文件 >> 选项 >> 勾选 “开发工具”，点击“确定”。

第三步：插入列表框控件

开发工具 >> 插入 >> ActiveX 控件  >> 列表框控件，绘制控件。

第四步：设置列表框控件属性

如下图，绘制好的列表框控件名称默认为“ListBox1”，当前为“设计模式”，点击“属性”，进入设置。

在弹出的属性设置框中，设置好样式、多选、选项值的数据源范围（即sheet2 "爱好"一列的数据，不包括表头）。

用同样的方法，新添加一个列表框控件，注意第二个列表框为ListBox2，并设置相关属性，多选项的数据源范围为“Sheet2!B2:B8”。

第五步：启用VBA代码

在状态栏找到并点击“查看代码”，或是在活动表Sheet1右击，选择“查看代码”，进入VBA编辑器。

注：如果Excel没有安装VBA支持库的，需要先安装好哦~

将下方代码复制，并调试编译

Private Sub ListBox1_Change()
If Reload Then Exit Sub '加载ListBox1
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then t = t & "," & ListBox1.List(i)
Next
ActiveCell = Mid(t, 2)
End Sub
Private Sub ListBox2_Change()
If Reload Then Exit Sub '加载ListBox2
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then t = t & "," & ListBox2.List(i)
Next
ActiveCell = Mid(t, 2)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ListBox1
        '第 2 列 且 单元格大于 1，因为表头的字段不需要进行多选
        If ActiveCell.Column = 2 And ActiveCell.Row > 1 Then
            t = ActiveCell.Value
            Reload = True '如果是根据单元格的值修改列表框，则暂时屏蔽listbox的change事件。
            For i = 0 To .ListCount - 1 '根据活动单元格

内容修改列表框中被选中的内容
                If InStr(t, .List(i)) Then
                    .Selected(i) = True
                    Else
                    .Selected(i) = False
                End If
            Next
            Reload = False
            .Top = ActiveCell.Top + ActiveCell.Height '以下语句根据活动单元格位置显示列表框
            .Left = ActiveCell.Left
            .Width = ActiveCell.Width
            .Visible = True
            Else
            .Visible = False
        End If
    End With
With ListBox2
        '第 4 列 且 单元格大于 1，因为表头的字段不需要进行多选
        If ActiveCell.Column = 4 And ActiveCell.Row > 1 Then
            t = ActiveCell.Value
            Reload = True '如果是根据单元格的值修改列表框，则暂时屏蔽listbox的change事件。
            For i = 0 To .ListCount - 1 '根据活动单元格内容修改列表框中被选中的内容
                If InStr(t, .List(i)) Then
                    .Selected(i) = True
                    Else
                    .Selected(i) = False
                End If
            Next
            Reload = False
            .Top = ActiveCell.Top + ActiveCell.Height '以下语句根据活动单元格位置显示列表框
            .Left = ActiveCell.Left
            .Width = ActiveCell.Width
            .Visible = True
            Else
            .Visible = False
        End If
    End With
End Sub

调试 >> 编译

再点击一次“设计模式”，让我们看看效果吧