先看视频：
下拉多选菜单/video/1070640311239249920
在日常工作中，有时候我们需要在单元格中输入多个固定内容的某几个项，手动输入很麻烦，我今天就带大家用excel的vba制作多选输入菜单。
以excel 为例
1、开启宏设置
新建excel，打开，依次点击：文件→选项→信任中心→信任中心设置→ActiveX设置，按下图选择，点击确认。
2、添加开发工具
依次点击：文件→选项→自定义功能区，右侧选择“所有选项卡”，下面勾选“开发工具”，点确认。
3、重命名sheet1为主表，sheet2位复选，在复选表中添加要在下拉菜单中呈现的数据。
注意：本示例中，复选表中的数据是从E列开始的，主表中能显示下拉菜单的列，也是从E列开始的。
4、插入listbox控件，设置属性
点击excel菜单“开发工具”，点击插入，选择“列表框”，在excel中画一个列表框控件，鼠标右键此控件，选择属性，在打开的属性对话框里将ListStyle设置为1-fmListStyleOption，将Multiselest设置为1-fmMultiSelectMulti，并确保“（名称）”属性为ListBox1
/video/1070647988464115712
5、点击主表，再点击Excel菜单“开发工具”，选择“查看代码”，复制下面的代码
Private Sub ListBox1_Change()Dim TXT As StringDim i As Integer, k As IntegerTXT = ""k = 0For i = 0 To ListBox1.ListCount - 1If ListBox1.Selected(i) = True Thenk = k + 1If TXT = "" ThenTXT = k & "." & ListBox1.List(i)ElseTXT = TXT & vbCrLf & k & "." & ListBox1.List(i)End If'TXT = IIf(TXT = "", ListBox1.List(i), TXT & "," & ListBox1.List(i))End IfNextActiveCell.Value = TXTEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)Dim DSoucre As StringDim EndRow As LongDim ColName As StringIf Selection.Count <> 1 Then ListBox1.Visible = False: Exit SubIf Not (Target.Row > 3 And Target.Column > 4) ThenListBox1.Visible = FalseExit SubEnd If'MsgBox Split(Target.Address, "$")(1)ColName = Split(Target.Address, "$")(1)EndRow = Sheets("复选").Columns(ColName & ":" & ColName).Find("*", , , , xlByRows, xlPrevious).RowIf EndRow <= 2 ThenMsgBox "无数据"Exit SubEnd IfDSoucre = "复选!" & ColName & "2:" & ColName & EndRowWith ListBox1.ListFillRange = DSoucre.ListStyle = fmListStyleOption.MultiSelect = fmMultiSelectMulti.Top = Target.Top + Target.Height.Left = Target.Left.Width = Target.WidthListBox1.Visible = TrueEnd WithEnd Sub
/video/1070651553697824768
以上...
下节课继续，但是我不知道要写什么......
评论里可以提要求，我会选一个，下节课出教程
ps: 如果有特别需求需要定制，可以私信我
