帶方框的√如何制作下拉菜單？

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

本文來自知乎Gauin李紅濤。