Note: The other languages of the website are Google-translated. Back to English

如何在Excel中創建具有多個選擇或值的下拉列表?

默認情況下,您只能在 Excel 的數據驗證下拉列表中選擇一項。 如何在下拉列表中進行多項選擇,如下 gif 所示? 本文中的方法可以幫助您解決問題。


使用VBA代碼創建具有多個選擇的下拉列表

本節提供了兩個 VBA 代碼來幫助您在工作表的下拉列表中進行多項選擇。 這兩個VBA代碼可以實現:

VBA 代碼 1:允許在下拉列表中進行多項選擇而不重複
VBA代碼2:允許在下拉列表中進行多項選擇而沒有重複(通過再次選擇刪除現有項目)

您可以應用以下 VBA 代碼之一在 Excel 工作表的下拉列表中進行多項選擇。 請執行以下操作。

1. 打開包含要從中進行多項選擇的數據驗證下拉列表的工作表。 右鍵單擊工作表選項卡並選擇 查看代碼 從上下文菜單。

2。 在裡面 Microsoft Visual Basic for Applications 窗口,將下面的VBA代碼複製到代碼窗口中。 看截圖:

VBA 代碼 1:允許在下拉列表中進行多項選擇而不重複

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 2019/11/13
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or _
                   InStr(1, xValue1, ", " & xValue2) Or _
                   InStr(1, xValue1, xValue2 & ",") Then
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & ", " & xValue2
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

3。 按 其他 + Q 關閉鍵 Microsoft Visual Basic for Applications 窗口。

現在您可以從當前工作表的下拉列表中選擇多個項目。

假設您不小心選擇了一個項目並且需要在不清除整個單元格並重新開始的情況下將其刪除。 下面的 VBA 代碼 2 可以幫你一個忙。

VBA代碼2:允許在下拉列表中進行多項選擇而沒有重複(通過再次選擇刪除現有項目)

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 2023/01/11
    'Updated by Ken Gardner 2022/07/11
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim semiColonCnt As Integer
    Dim xType As Integer
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    
    xType = 0
    xType = Target.Validation.Type
    If xType = 3 Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or xValue1 = xValue2 & ";" Or xValue1 = xValue2 & "; " Then ' leave the value if only one in list
                    xValue1 = Replace(xValue1, "; ", "")
                    xValue1 = Replace(xValue1, ";", "")
                    Target.Value = xValue1
                ElseIf InStr(1, xValue1, "; " & xValue2) Then
                    xValue1 = Replace(xValue1, xValue2, "") ' removes existing value from the list on repeat selection
                    Target.Value = xValue1
                ElseIf InStr(1, xValue1, xValue2 & ";") Then
                    xValue1 = Replace(xValue1, xValue2, "")
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & "; " & xValue2
                End If
                Target.Value = Replace(Target.Value, ";;", ";")
                Target.Value = Replace(Target.Value, "; ;", ";")
                If Target.Value <> "" Then
                    If Right(Target.Value, 2) = "; " Then
                        Target.Value = Left(Target.Value, Len(Target.Value) - 2)
                    End If
                End If
                If InStr(1, Target.Value, "; ") = 1 Then ' check for ; as first character and remove it
                    Target.Value = Replace(Target.Value, "; ", "", 1, 1)
                End If
                If InStr(1, Target.Value, ";") = 1 Then
                    Target.Value = Replace(Target.Value, ";", "", 1, 1)
                End If
                semiColonCnt = 0
                For i = 1 To Len(Target.Value)
                    If InStr(i, Target.Value, ";") Then
                        semiColonCnt = semiColonCnt + 1
                    End If
                Next i
                If semiColonCnt = 1 Then ' remove ; if last character
                    Target.Value = Replace(Target.Value, "; ", "")
                    Target.Value = Replace(Target.Value, ";", "")
                End If
            End If
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

筆記:

1)。 下拉列表中不允許出現重複值。
2)。 上面的 VBA 代碼 2 由我們的熱心用戶 Ken Gardner 於 2022/07/11 提供。
3)。 請將工作簿另存為 Excel啟用宏的工作簿 為了使代碼在將來繼續工作。
4)。 添加 VBA 代碼 2 後,您可以通過在下拉列表中再次選擇現有項目來刪除它。 請看下面的 gif:


使用出色的工具輕鬆創建具有多個選擇的下拉列表

在這裡我們強烈推薦 多選下拉列表 的特點 Excel的Kutools 為了你。 使用此功能,您可以根據需要從下拉列表中輕鬆選擇指定範圍,當前工作表,當前工作簿或所有打開的工作簿中的多個項目。

申請前 Excel的Kutools首先下載並安裝.

1。 點擊 庫工具 > 下拉列表 > 多選下拉列表 > 設置。 見截圖:

2。 在裡面 多選下拉列表設置 對話框,請進行以下配置。

  • 2.1)在 適用於 部分。 在這種情況下,我選擇 當前工作表 來自 指定範圍 下拉列表;
  • 2.2)在 文本方向 部分,根據需要選擇文本方向;
  • 2.3)在 分離器 框,輸入一個定界符,將用於分隔多個值;
  • 2.4)檢查 不要添加重複項 盒子裡 選項 如果您不想在下拉列表單元格中重複,請選擇“部分”。
  • 2.5)點擊 OK 按鈕。 看截圖:

3.請點擊 庫工具 > 下拉列表 > 多選下拉列表 啟用該功能。

現在,您可以從當前工作表的下拉列表中或在步驟2中指定的任何範圍中選擇多個項目。

  如果您想免費試用(30-day) 這個實用程序, 請點擊下載,然後按照上述步驟進行操作。


相關文章:

在Excel下拉列表中鍵入時自動完成
如果您有一個包含大值的數據驗證下拉列表,則需要在列表中向下滾動以查找合適的列表,或直接在列錶框中鍵入整個單詞。 如果在下拉列表中鍵入第一個字母時有允許自動完成的方法,一切將變得更加容易。 本教程提供了解決問題的方法。

在Excel中從另一個工作簿創建下拉列表
在工作簿中的工作表之間創建數據驗證下拉列表非常容易。 但是,如果數據驗證所需的列表數據位於另一個工作簿中,您將怎麼辦? 在本教程中,您將詳細了解如何從Excel中的另一個工作簿創建拖放列表。

在Excel中創建可搜索的下拉列表
對於具有眾多價值的下拉列表,找到合適的價值並非易事。 以前,我們已經介紹了一種在下拉框中輸入第一個字母時自動完成下拉列表的方法。 除了自動完成功能之外,您還可以使下拉列表可搜索,以提高在下拉列表中查找適當值時的工作效率。 為了使下拉列表可搜索,請嘗試本教程中的方法。

在Excel下拉列表中選擇值時自動填充其他單元格
假設您已經根據單元格區域B8:B14中的值創建了一個下拉列表。 在下拉列表中選擇任何值時,都希望在選定單元格中自動填充單元格範圍C8:C14中的相應值。 為了解決該問題,本教程中的方法將對您有所幫助。

下拉列表的更多教程...


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (67)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
嗨,感謝您的解決方案和代碼。 但下一步是如何確保用戶不會從下拉列表中選擇“重複”值。 例如,如果列表中有 4 個項目 - 橙子、蘋果、香蕉、桃子,並且如果用戶已經選擇了“橙子”,那麼 excel 不應該允許用戶選擇“橙子”,或者應該從其餘的選項中刪除該選項名單。 您能否發布代碼來完成此功能。 謝謝。 耶茲迪
網站主持人對此評論進行了最小化
嗨,Yezdi,謝謝您的評論。 代碼已更新,現在下拉列表中不允許出現重複值。 謝謝。 陽光
網站主持人對此評論進行了最小化
很高興這允許多項選擇,但就像@Yezdi 評論的那樣,我發現即使我不選擇它們也會添加一個或多個重複項。 所以,目前,這是一個 80% 的解決方案……離完美還差一點點調整。 我不是 VB 編碼員,否則我會提供解決方案。
網站主持人對此評論進行了最小化
您可以更改以下行中的代碼以防止重複: If xValue2 "" Then Target.Value = xValue1 & ", " & xValue2 End If To: If xValue2 "" Then If CheckIfAlreadyAdded(xValue1, xValue2) = False Then Target .Value = xValue1 & ", " & xValue2 Else Target.Value = xValue1 End If End If 然後添加以下函數: Private Function CheckIfAlreadyAdded(ByVal sText As String, sNewValue As String) As Boolean CheckIfAlreadyAdded = False Dim WrdArray() As String WrdArray() = Split(sText, ",") For i = LBound(WrdArray) To UBound(WrdArray) If Trim(WrdArray(i)) = Trim(sNewValue) Then CheckIfAlreadyAdded = True Next i End Function -- 可能有更好的編碼方式,但它現在有效。
網站主持人對此評論進行了最小化
剛剛意識到如果條件已設置,我沒有退出新函數中的循環,因此我們不必檢查其他條目。
網站主持人對此評論進行了最小化
你好。 感謝您提供代碼並添加限制重複項。 再提出一個要求 - 必須進行哪些添加/更改才能僅允許在一或兩個特定列中進行多項選擇? 如果我要糾正錯字,或對單元格中的文本進行更改或添加,則此代碼會將文本行重新添加到應該是“普通”單元格中,而不是僅僅表現“正常”並接受更改(無需再次重新添加整個文本)。 例如,A 列是“普通”列。 我寫了一句“你最想要的三個項目是什麼?” B 列是一個“列表”列,我只希望能夠選擇一個值(在這種情況下,假設是一個孩子的名字)。 C 列是另一個“列表”列,用戶必須能夠在其中選擇多個項目(這段代碼讓我可以完美地做到這一點)。 隨著我的進行,我意識到我在 A 列中輸入了一個錯字,並想更正它。 就這段代碼而言,如果我進入(雙擊,F2)並更正“項目”這個詞,我最終會在我的單元格中得到這個結果:“你最想要的三個項目是什麼?三個是什麼?你最想要的東西?” 提前感謝您的任何幫助(來自真正喜歡 VBA,但仍處於學習初期的用戶!)
網站主持人對此評論進行了最小化
我能夠讓代碼工作,但是當我保存文檔(啟用宏),關閉它並返回時,代碼不再工作(儘管它仍然在那裡)。 我不知道我做錯了什麼。 有任何想法嗎?
網站主持人對此評論進行了最小化
嗨 Cynthia, 如果原作者沒有回复,我會給你答复,但我只會在 29 月 XNUMX 日再次出現在電腦前。 我也不是 VBA 程序員。 與此同時,您可以做的是谷歌搜索如何識別列號,並且只有在該特定列中編輯數據時才讓代碼運行。 我已經完成了,但代碼在我的工作 PC 上,目前無法回憶,也許嘗試在 target.column 上放置一個 debug.print 或類似的東西,看看它是否給你正在編輯的列號. 抱歉,詹妮弗,不確定您遇到的問題:(
網站主持人對此評論進行了最小化
@Cynthia,如果仍然需要,您應該能夠執行類似的操作,以確保代碼在特定列上運行,在我的情況下為第 34 列和第 35 列: If (Target.Column 34 And Target.Column 35) Then Exit Sub '將此代碼放在昏暗語句之後的開頭
網站主持人對此評論進行了最小化
[quote]@Cynthia,如果仍然需要,您應該能夠執行類似的操作,以確保代碼僅在特定列上運行,在我的情況下,列 34 和 35:如果(Target.Column 34 和 Target.Column 35)然後 Exit Sub '將此代碼放在您的昏暗語句之後的開頭通過默文[/quote] 嗨@Mervyn,完全丟失了線程,但非常感謝您的回复。 我已經嘗試應用 If (Target.Column 34 And Target.Column 35) Then Exit Sub (我的版本讀取 If (Target.Column4 And Target.Column5) Then Exit Sub 如您提供的那樣,但我得到了“運行時error '438': Object doesn't support this property or method"" error on this new line. 這是我代碼的前幾行: Private Sub Worksheet_Change(ByVal Target As Range) Dim xRng As Range Dim xValue1 As String Dim xValue2 As String If (Target.Column4 And Target.Column5) Then Exit Sub If Target.Count > 1 Then Exit Sub On Error Resume Next 我的工作表只有 6 列:問題 | 答案 | 類別 | 子類別 | 標籤 | 照片鏈接我只需要子類別和標籤中的多個值下拉列表(第 4 列和第 5 列)。我將按照您在 12/23 上的建議繼續查找信息,並將查看 Charity 提供的鏈接。
網站主持人對此評論進行了最小化
If Target.Column <> 34 Then Exit Sub

'將此代碼放在昏暗語句之後的開頭
網站主持人對此評論進行了最小化
嗨,我目前正在使用此公式,並且所有具有數據驗證的列現在都有多項選擇選項,但是我想將多項選擇限制為一列。 有人可以為我編輯此公式,以便多項選擇僅適用於 Column4 嗎? 謝謝 :) Private Sub Worksheet_Change(ByVal Target As Range) '更新:2016/4/12 Dim xRng As Range Dim xValue1 As String Dim xValue2 As String If Target.Count > 1 Then Exit Sub On Error Resume Next Set xRng = Cells. SpecialCells(xlCellTypeAllValidation) 如果 xRng 沒有,則退出子 Application.EnableEvents = False 如果不是 Application.Intersect(Target, xRng) 沒有,則 xValue2 = Target.Value Application.Undo xValue1 = Target.Value Target.Value = xValue2 If xValue1 " " Then If xValue2 "" Then If xValue1 = xValue2 Or _ InStr(1, xValue1, ", " & xValue2) Or _ InStr(1, xValue1, xValue2 & ",") Then Target.Value = xValue1 Else Target.Value = xValue1 & ", " & xValue2 End If End If End If End If End If Application.EnableEvents = True End Sub 任何幫助將不勝感激!
網站主持人對此評論進行了最小化
這很好用,但是一旦選擇我就無法刪除項目。 如果我不小心點擊了某些東西並且需要在沒有(希望)清除整個單元格並重新開始的情況下將其刪除,有什麼建議嗎? 此外,對於那些尋求定義一列或多列的人,Contextures 對此處提供的代碼有一個很好的補充,可以讓您做到這一點。 http://www.contextures.com/excel-data-validation-multiple.html#column
網站主持人對此評論進行了最小化
[quote]這很好用,但是一旦選擇我就無法刪除項目。 如果我不小心點擊了某些東西並且需要在沒有(希望)清除整個單元格並重新開始的情況下將其刪除,有什麼建議嗎? 此外,對於那些尋求定義一列或多列的人,Contextures 對此處提供的代碼有一個很好的補充,可以讓您做到這一點。 http://www.contextures.com/excel-data-validation-multiple.html#column慈善機構[/quote] 代碼運行良好。 但是,我似乎無法取消選擇項目。 當我想從選擇中刪除一個項目時,它只是沒有被刪除。 有沒有其他人也遇到過這個問題?[/quote] 大家好,找到這個問題的任何解決方案..請分享..
網站主持人對此評論進行了最小化
您好,代碼工作正常。 但是,我似乎無法取消選擇項目。 當我想從選擇中刪除一個項目時,它只是沒有被刪除。 有沒有其他人也遇到過這個問題?
網站主持人對此評論進行了最小化
這個問題有回复嗎。 這是我遇到的同樣的問題。 似乎沒有辦法刪除已選擇的項目。
網站主持人對此評論進行了最小化
刪除單元格中的內容,然後重新選擇
網站主持人對此評論進行了最小化
大家好,我在 Excel 工作表上有此代碼,並在選擇單元格時從下拉列表中清除內容 - 我知道代碼的哪一部分正在執行此操作(顯示“fillRng.ClearContents”的部分),我已嘗試使用上述某些方法來修復它失敗...我是 VBA 編程等新手。任何人都可以提供有關如何更改它的任何幫助,以便在選擇單元格時它不會清除並且條目不會被請複制?? Option Explicit Dim fillRng As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Qualifiers As MSForms.ListBox Dim LBobj As OLEObject Dim i As Long Set LBobj = Me.OLEObjects("ListBox1") Set Qualifiers = LBobj.Object If Target.Row > 3 And Target.Column = 3 Then Set fillRng = Target With LBobj .Left = fillRng.Left .Top = fillRng.Top .Width = fillRng.Width .Height = 155 .Visible = True End With Else LBobj.Visible = False If不是 fillRng 什麼都沒有 然後 fillRng.ClearContents 帶限定符 If .ListCount 0 Then For i = 0 To .ListCount - 1 If fillRng.Value = "" Then If .Selected(i) Then fillRng.Value = .List(i) Else If .Selected(i) Then fillRng.Value = _ fillRng.Value & ", " & .List(i) End If Next End If For i = 0 To .ListCount - 1 .Selected(i) = False Next End With Set fillRng = 沒有 End If End If End If End Sub
網站主持人對此評論進行了最小化
大家好,我可以完美地完成我的下拉列表,但我的問題是:當我選擇所有需要的項目時,它會以水平方式依次通過單元格,例如:黃色、綠色、黑色、紅色。 但是我怎樣才能讓它看起來垂直呢?,更像是:橙色,黑色,黃色,紅色,因為在水平方向上,當選擇很多項目時,單元格會變得很長。 你能告訴我是否有任何方法可以做到這一點? 謝謝你,西瑞
網站主持人對此評論進行了最小化
我設法使用此代碼並成功創建了多個選擇下拉框。 當我在不同的日子關閉並重新打開時,它就起作用了。 但是,現在並非我最初選擇的所有單元格都允許多選。 儘管使用了整個電子表格的代碼,但只有以前完成的。 你能幫我嗎?
網站主持人對此評論進行了最小化
我有同樣的問題。
網站主持人對此評論進行了最小化
單元格很可能被鎖定,右鍵單擊所有單元格,轉到格式化單元格,保護,然後取消選中鎖定單元格選項
網站主持人對此評論進行了最小化
我創建了一個下拉列表,其中可以選擇多個文本選擇,例如“營養”、“體重”和“工作”,以便每個呼叫者打電話的原因。我有一個摘要頁面,我想查看每個原因有多少在特定月份中顯示。 我將使用什麼公式來告訴 Excel 在給定的月份中分別提取並統計這些中的每一個? 目前,按照我的設置方式,只有當我在單元格中為每個呼叫者都有一個原因時,它才會正確計算。
網站主持人對此評論進行了最小化
美好的一天,
抱歉不能幫你解決這個問題。 如果您找到答案,請告訴我。
網站主持人對此評論進行了最小化
我正在嘗試使用可以選擇多個值的下拉列表創建 4 列。 如何修改“具有多項選擇的下拉列表”VBA 代碼,以便在單擊已輸入的值時將其從單元格中刪除? 先感謝您。
網站主持人對此評論進行了最小化
親愛的蘭迪,
你是什​​麼意思“當我點擊一個已經輸入的值時,它會從單元格中刪除它?”
網站主持人對此評論進行了最小化
我也有同樣的問題。 我的下拉列表不記得選擇的值。 如果有人單擊已填充的單元格(不是他們,而是其他人),則所選值將被清除,並且該單元格再次為空白。
網站主持人對此評論進行了最小化
我正在使用下面的代碼來允許在多個工作表上進行多選,但是當我轉到工作簿中的另一個工作表時,多選就會消失。 當我保存文件並返回時,它將適用於帶有代碼的一個選項卡,但是當我再次單擊帶有代碼的另一個選項卡時,它不再起作用。 知道如何解決它,所以如果我單擊帶有 VBA 代碼的工作表,它將始終允許多選?
網站主持人對此評論進行了最小化
嗨,ich bin totaler VBA 萊耶。 Ich versuche den Code so zu modifizieren, dass
a) die Mehrfachauswahl nicht in allen, sondern nur ein zwei Spalten aktivist
b) ich Items auch wieder rausnehmen kann, zB in dem ich in der Listenauswahl das Item noch einmal anklicke (Beispiel: ich habe über die Mehrfachauswahl ausgewählt: A, D, X, Y... nun fällt mir auf, dass D nicht dazu gehört. Beim aktuellen Code müsste ich Eingaben entfernen und neu auswählen)。
提前感謝!
網站主持人對此評論進行了最小化
我無法繼續創建下拉列表的多項選擇。 我已經聽過教程並閱讀了材料,但仍然無法創建。 有人可以幫助我嗎?
網站主持人對此評論進行了最小化
我知道這可能是完全隨機的,但我使用 VBA 的變體沒有問題。 除了在一頁上,如果你選擇前三個選項,它不會讓你選擇第四個。 它會讓您選擇第 5、第 6 等等,而不是第 4 選項。 想法?
網站主持人對此評論進行了最小化
羅伯特,
我已經測試了代碼,但沒有發現你提到的問題。 您能告訴我您使用的是哪個 Excel 版本嗎? 感謝您的評論。
這裡還沒有評論
載入更多
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護