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

如何在Excel中创建具有多个选择或值的下拉列表?

默认情况下,您只能在 Excel 的数据验证下拉列表中选择一项。 如何在下拉列表中进行多项选择,如下 gif 所示? 本文中的方法可以帮助您解决问题。

使用VBA代码创建具有多个选择的下拉列表
使用出色的工具轻松创建具有多个选择的下拉列表

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


使用VBA代码创建具有多个选择的下拉列表

本节提供两个 VBA 代码来帮助您在工作表的下拉列表中进行多项选择。 这两个VBA代码可以实现:

VBA 代码 1:允许在下拉列表中进行多项选择而不重复
VBA代码2:允许在下拉列表中进行多项选择而没有重复(通过再次选择删除现有项目)

您可以应用以下 VBA 代码之一在 Excel 工作表的下拉列表中进行多项选择。 请执行以下操作。

1. 打开包含要从中进行多项选择的数据验证下拉列表的工作表。 右键单击工作表选项卡并选择 查看代码 从上下文菜单。

2。 在里面 Microsoft Visual Basic应用程序 窗口,将下面的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应用程序 窗口。

现在您可以从当前工作表的下拉列表中选择多个项目。

假设您不小心选择了一个项目并且需要在不清除整个单元格并重新开始的情况下将其删除。 下面的 VBA 代码 2 可以帮你一个忙。

VBA代码2:允许在下拉列表中进行多项选择而没有重复(通过再次选择删除现有项目)

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2019/11/13
'Updated by Ken Gardner 2022/07/11
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
Dim semiColonCnt As Integer
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
If Application.Intersect(Target, xRng) Then
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 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
End If
Application.EnableEvents = True
End Sub

说明:

1)。 下拉列表中不允许出现重复值。
2)。 上面的 VBA 代码 2 由我们的热心用户 Ken Gardner 于 2022/07/11 提供。
3)。 请将工作簿另存为 Excel启用宏的工作簿 为了使代码在将来继续工作。
4)。 添加 VBA 代码 2 后,您可以通过在下拉列表中再次选择现有项目来删除它。 请看下面的 gif:


使用出色的工具轻松创建具有多个选择的下拉列表

在这里我们强烈推荐 多选下拉列表 的特点 Kutools for Excel 为了你。 使用此功能,您可以根据需要从指定范围内的下拉列表中轻松选择多个项目,当前工作表,当前工作簿或所有打开的工作簿。

申请前 Kutools for Excel首先下载并安装.

1。 点击 库工具 > 下拉列表 > 多选下拉列表 > 点击“设置”。 看截图:

2。 在里面 多选下拉列表设置 对话框,请进行以下配置。

  • 2.1)在 适用于 部分。 在这种情况下,我选择 当前工作表 来自 指定范围 下拉列表;
  • 2.2)在 文本方向 部分,根据需要选择文本方向;
  • 2.3)在 分隔器 框,输入一个定界符,将用于分隔多个值;
  • 2.4)检查 不要添加重复项附加选项 如果您不想在下拉列表单元格中重复,请选择“部分”。
  • 2.5)点击 OK 按钮。 看截图:

3.请点击 库工具 > 下拉列表 > 多选下拉列表 启用该功能。

现在,您可以从当前工作表的下拉列表中或在步骤2中指定的任何范围中选择多个项目。

  如果您想免费试用该工具(30天), 请点击下载,然后按照上述步骤进行操作。


相关文章:

在Excel下拉列表中键入时自动完成
如果您有一个包含大值的数据验证下拉列表,则需要在列表中向下滚动以查找合适的列表,或直接在列表框中键入整个单词。 如果在下拉列表中键入第一个字母时有允许自动完成的方法,一切将变得更加容易。 本教程提供了解决问题的方法。

在Excel中从另一个工作簿创建下拉列表
在工作簿中的工作表之间创建数据验证下拉列表非常容易。 但是,如果数据验证所需的列表数据位于另一个工作簿中,您将怎么办? 在本教程中,您将详细了解如何从Excel中的另一个工作簿创建拖放列表。

在Excel中创建可搜索的下拉列表
对于具有众多价值的下拉列表,找到合适的价值并非易事。 以前,我们已经介绍了一种在下拉框中输入第一个字母时自动完成下拉列表的方法。 除了自动完成功能之外,您还可以使下拉列表可搜索,以提高在下拉列表中查找适当值时的工作效率。 为了使下拉列表可搜索,请尝试本教程中的方法。

在Excel下拉列表中选择值时自动填充其他单元格
假设您已经基于单元格区域B8:B14中的值创建了一个下拉列表。 在下拉列表中选择任何值时,都希望在选定单元格中自动填充单元格范围C8:C14中的相应值。 为了解决该问题,本教程中的方法将对您有所帮助。

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


最佳办公效率工具

Kutools for Excel解决了您的大多数问题,并使您的生产率提高了80%

  • 重用: 快速插入 复杂的公式,图表 以及您以前使用过的任何东西; 加密单元 带密码 创建邮件列表 并发送电子邮件...
  • 超级公式栏 (轻松编辑多行文本和公式); 阅读版式 (轻松读取和编辑大量单元格); 粘贴到过滤范围...
  • 合并单元格/行/列 不会丢失数据; 拆分单元格内容; 合并重复的行/列...防止细胞重复; 比较范围...
  • 选择重复或唯一 行; 选择空白行 (所有单元格都是空的); 超级查找和模糊查找 在许多工作簿中; 随机选择...
  • 确切的副本 多个单元格,无需更改公式参考; 自动创建参考 到多张纸; 插入项目符号,复选框等...
  • 提取文字,添加文本,按位置删除, 删除空间; 创建和打印分页小计; 在单元格内容和注释之间转换...
  • 超级滤镜 (将过滤方案保存并应用于其他工作表); 高级排序 按月/周/日,频率及更多; 特殊过滤器 用粗体,斜体...
  • 结合工作簿和工作表; 根据关键列合并表; 将数据分割成多个工作表; 批量转换xls,xlsx和PDF...
  • 超过300种强大功能。 支持Office / Excel 2007-2019和365。支持所有语言。 在您的企业或组织中轻松部署。 完整功能30天免费试用。 60天退款保证。
kte选项卡201905

Office选项卡为Office带来了选项卡式界面,使您的工作更加轻松

  • 在Word,Excel,PowerPoint中启用选项卡式编辑和阅读,发布者,Access,Visio和Project。
  • 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
  • 每天将您的工作效率提高50%,并减少数百次鼠标单击!
officetab底部
按评论排序
注释 (38)
还没有评分。 成为第一位评论!
该评论由网站上的主持人最小化
嗨,感谢您的解决方案和代码。 但下一步是如何确保用户不会从下拉列表中选择“重复”值。 例如,如果列表中有 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   产品特性
建议地点