最近在回答小伙伴问题的时候，发现大家已经不满足于简单的单选下拉菜单了，有小伙伴提出如何制作多选下拉菜单，这是个极好的问题啊，今天就来帮忙答疑解惑。

图片

如上图所示，兴趣爱好一列可以选择多个选项，并且选择后自动填入单元格，每个选项之间用分号自动分隔，选择单元格时右侧自动弹出下拉菜单。要实现这个效果，自然不是简单的Excel界面操作就能完成的，需要使用到控件和VBA代码。不过别担心，代码准备好了，只要大家按照步骤操作，准保可以实现。一、插入列表框选择【开发工具】选项卡，点击【插入】，选择列表框，具体操作参见动图演示：

图片

二、复制粘贴代码工作表标签右击鼠标，选择查看代码，粘贴下面的代码。具体操作参见动图演示：

图片

代码如下：

Private Sub ListBox1_Change()

    If Reload Then Exit Sub

    For i = 0 To ListBox1.ListCount - 1

        If ListBox1.Selected(i) = True Then t = t & "；" & Trim(ListBox1.List(i))

    Next

    ActiveCell = Mid(t, 2)

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With ListBox1

        If ActiveCell.EntireRow.Range("a1") <> "" And ActiveCell.Column = 5 And ActiveCell.Row > 1 Then

            t = ActiveCell.Value

            Reload = True

            For i = 0 To .ListCount - 1

                If InStr(t, .List(i)) Then

                    .Selected(i) = True

                Else

                    .Selected(i) = False

                End If

            Next

            Reload = False

            .MultiSelect = fmMultiSelectMulti

            .ListStyle = fmListStyleOption

            .ListFillRange = "sheet2!a2:a" & Sheet2.Cells(1, 1).End(xlDown).Row

            .Top = ActiveCell.Offset(0, 1).Top

            .Left = ActiveCell.Offset(0, 1).Left

            .Width = ActiveCell.Width

            .Height = ActiveCell.Height * 6

            .Visible = True

        Else

            .Visible = False

        End If

    End With

End Sub

三、测试运行点击【开发工具】选项卡，取消设计模式，尝试一下菜单是否可以正常显示。

图片

四、代码调整这里的菜单应用在Sheet1工作表中的E列，其它列点击鼠标是没有这个效果的。并且菜单列表放置在另外一个工作表Sheet2的A列。

图片

如果大家的工作表名称和列位置与案例不一致，就需要对代码做微调，调整方法如下：

图片

① IF 语句需要满足三个条件。第一个是活动单元格所在行的第一个单元格不为空，第二个是活动单元格所在列为第五列，第三个条件是活动单元格所在的行大于1，只有这三个条件同时满足才能应用下拉菜单。如果大家下拉菜单应用的位置和案例不同，需要进行相应的调整。② 这里用来设置下拉菜单的数据源。工作表2的a2单元格到最后一个非空单元格，如果你的工作表不是sheet2，数据源的范围也不同，也是要做相应调整的。 本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。