Excel下拉列表多选框实现
Excel提供了下拉列表的实现，但并不支持多选，后来慢慢找资料终于利用VBA编程实现了多选的问题。
首先点击视图->宏，工程资源所示：
有Microsoft Excel对象：对应的是Sheet1或Sheet2对像等;
窗体:对应的是弹出的对话框；
模块:对应的是调用某些功能的入口。
?
以Sheet1页单击D列为例弹出框供多选
1：
先建立宏，然后编辑，在"Microsoft Excel对象"中单击"Sheet2"的右键-》查看代码
将此代码保存：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)? //说明：监听sheet1发生的用户操作事件
??? If ActiveCell.Column = 8 And ActiveCell.Row > 1 Then? //说明:当前激活列为J列，第二行以下
??????? Call ShowFM2? //调用显示窗体宏名
??? End If
End Sub
?
2：
在工程资源-》"模块"对象 中 “插入模块”-》查看代码
保存如下代码：
Sub ShowFM()
?? UserForm1.Show
End Sub
?
3：
在工程资源->"窗体"->插入"用户窗体"
然后在"工具箱"里拖放"列表框"和"命令按钮"到窗体上
接着点击"查看代码"
?
将以下代码保存：
?
Private Sub CommandButton1_Click()
Dim Arr(), k&, i&
ReDim Arr(1 To 1)
With ListBox1
??? For i = 0 To .ListCount - 1
??????? If .Selected(i) Then
??????????? k = k + 1
??????????? ReDim Preserve Arr(1 To k)
??????????? 'Arr(k) = .List(i, 1)
??????????? Arr(k) = Sheet2.Range("A" & (i + 1)).Value //获取Sheet2列表中A列i+1行的值
??????? End If
??? Next i
End With
'MsgBox "您选择了：" & Join(Arr, ",")
UserForm1.Hide
'Application.ActiveSheet.Range("A1").Value = Join(Arr, ",")
Application.ActiveCell.Value = Join(Arr, ",") //将值放入到当前单元格
End Sub
Private Sub ListBox1_Click()
???
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Initialize()
With UserForm1.ListBox1
??? .RowSource = "Sheet2!A1:A49"??? '设定源数据区域 ，下拉列表框的数据来源
??? .ColumnCount = 1?????????????? '设定列数
??? .ColumnHeads = False???????????? '设定列标题。标题为数据区域的上一行
??? .BoundColumn = 2
??? .MultiSelect = fmMultiSelectMulti?????? '按空格键或单击鼠标以选定列表中一个条目或取消选定。
'??? .MultiSelect = fmMultiSelectExtended??? '按 Shift 并单击鼠标，或按 Shift 的同时按一个方向键，将所选条目由前一项扩展到当前项。按 Ctrl 的同时单击鼠标可选定或取消选定。
'??? .MultiSelect = fmMultiSelectSingle????? '只可选择一个条目（默认）。
End With
End Sub
-----
?
保存试试看，不行的话看附件
