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

网友投稿 452 2023-12-23

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

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

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

1) 允许在一个下拉列表中多选，不重复

2) 允许在下拉列表中进行多项选择而不重复（通过再次选择删除现有项目）

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

使用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

Copy

3。按其他 + Q 关闭键 Microsoft Visual Basic应用程序 窗口。

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

假设您不小心选择了一个项目并且需要在不清除整个单元格并重新开始的情况下将其删除。下面的 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