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
-----
保存试试看，不行的话看附件
