在 Excel 下拉列表中选择多个项目——完整指南

Excel 下拉列表是确保数据一致性并简化输入的绝佳工具。然而，默认情况下，它仅允许选择单个项目。如果您需要从同一个下拉列表中选择多个项目，该怎么办？本综合指南将为您详细介绍如何在 Excel 下拉列表中启用多选功能、管理重复项、设置自定义分隔符，以及定义这些列表的作用范围。

• 使用 VBA 代码
• 通过 Kutools for Excel 仅需几次点击即可完成

• 允许重复项
• 移除所有现有项
• 设置自定义分隔符
• 设置限定区域
• 在受保护的工作表中执行

在下拉列表中启用多选

本节为您提供两种方法，轻松在 Excel 下拉列表中启用多选功能。

使用 VBA 代码

要启用下拉列表的多选功能，您可以借助 Excel 中的“Visual Basic for Applications”（VBA）。通过该脚本，可将下拉列表的行为修改为支持多选。请按以下步骤操作：

步骤 1：打开工作表（代码）编辑器

1. 打开包含您要启用多选功能的下拉列表所在的工作表。
2. 右键单击工作表标签，然后从上下文菜单中选择“查看代码”。
   

步骤 2：使用 VBA 代码

现在，请将以下 VBA 代码复制并粘贴到已打开的工作表（代码）窗口中。

VBA 代码：在 Excel 下拉列表中启用多选功能。

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20240118
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim delimiter As String
    Dim TargetRange As Range

    Set TargetRange = Me.UsedRange ' Users can change target range here
    delimiter = ", " ' Users can change the delimiter here

    If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
    On Error Resume Next
    Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False

    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
    Target.Value = xValue2
    If xValue1 <> "" And xValue2 <> "" Then
        If Not (xValue1 = xValue2 Or _
                InStr(1, xValue1, delimiter & xValue2) > 0 Or _
                InStr(1, xValue1, xValue2 & delimiter) > 0) Then
            Target.Value = xValue1 & delimiter & xValue2
        Else
            Target.Value = xValue1
        End If
    End If

    Application.EnableEvents = True
    On Error GoTo 0
End Sub

效果

返回工作表后，下拉列表将允许您选择多个选项，请参见下方演示：

通过 Kutools for Excel 仅需几次点击即可完成

如果您不熟悉 VBA，不妨试试更简单的替代方案——使用“Kutools for Excel”的“使下拉列表可多次选择”功能。这款用户友好的工具能轻松实现下拉列表的多选设置，让您自由自定义分隔符，并高效管理重复项，灵活满足多样化需求。

安装 Kutools for Excel 后，转到“Kutools”选项卡，依次选择“下拉列表”>“使下拉列表可多次选择”，然后按如下方式配置。

1. 指定包含支持多选的下拉列表的区域。
2. 指定下拉列表单元格中所选项目数量的分隔符。
3. 单击“确定”即可完成设置。
   

效果

现在，当您单击限定区域中带有下拉列表的单元格时，其旁边会立即弹出一个列表框。只需点击项目旁的“+”按钮，即可将其添加到下拉单元格中；点击“——”按钮，则可轻松移除不再需要的项目。请参见下方演示：

多选下拉列表的更多操作

本节汇总了在数据验证下拉列表中启用多选功能时可能遇到的各种场景。

在下拉列表中允许重复项

当下拉列表允许多选时，重复项可能会引发问题。上述 VBA 代码可防止下拉列表中出现重复项。如需保留重复项，请尝试本节提供的 VBA 代码。

VBA 代码：在数据验证下拉列表中允许重复项

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20240118
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim delimiter As String
    Dim TargetRange As Range

    Set TargetRange = Me.UsedRange ' Users can change target range here
    delimiter = ", " ' Users can change the delimiter here

    If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
    On Error Resume Next
    Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False

    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
    Target.Value = xValue2
    If xValue1 <> "" And xValue2 <> "" Then
        Target.Value = xValue1 & delimiter & xValue2
    End If

    Application.EnableEvents = True
    On Error GoTo 0
End Sub

效果

现在，您可以从当前工作表的下拉列表中选择多个项目。若要在下拉列表单元格中重复选择某个项目，请继续从列表中点选该项目。请参见截图：

从下拉列表中移除现有项目

从下拉列表中选择多个项目后，有时您可能需要移除其中某个已选项目。本节提供了另一段 VBA 代码，助您轻松完成此操作。

VBA 代码：从下拉列表单元格中移除任意现有项目

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 20240118
    Dim xRngDV As Range
    Dim TargetRange As Range
    Dim oldValue As String
    Dim newValue As String
    Dim delimiter As String
    Dim allValues As Variant
    Dim valueExists As Boolean
    Dim i As Long
    Dim cleanedValue As String

    Set TargetRange = Me.UsedRange ' Set your specific range here
    delimiter = ", " ' Set your desired delimiter here

    If Target.CountLarge > 1 Then Exit Sub

    ' Check if the change is within the specific range
    If Intersect(Target, TargetRange) Is Nothing Then Exit Sub

    On Error Resume Next
    Set xRngDV = Target.SpecialCells(xlCellTypeAllValidation)
    If xRngDV Is Nothing Or Target.Value = "" Then
        ' Skip if there's no data validation or if the cell is cleared
        Application.EnableEvents = True
        Exit Sub
    End If
    On Error GoTo 0

    If Not Intersect(Target, xRngDV) Is Nothing Then
        Application.EnableEvents = False
        newValue = Target.Value
        Application.Undo
        oldValue = Target.Value
        Target.Value = newValue

        ' Split the old value by delimiter and check if new value already exists
        allValues = Split(oldValue, delimiter)
        valueExists = False
        For i = LBound(allValues) To UBound(allValues)
            If Trim(allValues(i)) = newValue Then
                valueExists = True
                Exit For
            End If
        Next i

        ' Add or remove value based on its existence
        If valueExists Then
            ' Remove the value
            cleanedValue = ""
            For i = LBound(allValues) To UBound(allValues)
                If Trim(allValues(i)) <> newValue Then
                    If cleanedValue <> "" Then cleanedValue = cleanedValue & delimiter
                    cleanedValue = cleanedValue & Trim(allValues(i))
                End If
            Next i
            Target.Value = cleanedValue
        Else
            ' Add the value
            If oldValue <> "" Then
                Target.Value = oldValue & delimiter & newValue
            Else
                Target.Value = newValue
            End If
        End If

        Application.EnableEvents = True
    End If
End Sub

效果

这段 VBA 代码让您能够从下拉列表中轻松选择多个项目，并随时移除其中任意已选项——只需再次点击该选项，即可将其取消。

设置自定义分隔符

上述 VBA 代码中的分隔符均设为逗号。您可将该变量修改为任意所需字符，用作下拉列表选项的分隔符。操作方法如下：

如您所见，上述 VBA 代码均包含以下行：

delimiter = ", "

您只需将逗号替换为您所需的任意分隔符即可。例如，若希望使用分号分隔项目，请将该行修改为：

delimiter = "; "

delimiter = vbNewLine

设置限定区域

上述 VBA 代码适用于当前工作表中的所有下拉列表。若您希望仅对特定范围内的下拉列表应用该 VBA 代码，可按如下方式在代码中指定相应范围。

如您所见，上述 VBA 代码均包含以下行：

Set TargetRange = Me.UsedRange

您只需将该行修改为：

Set TargetRange = Me.Range("C2:C10")

在受保护的工作表中执行

假设您已使用密码“123”保护了工作表，并在启用保护前将下拉列表所在的单元格设置为“未锁定”，以确保多选功能在工作表受保护后仍可正常使用。然而，上述 VBA 代码在此场景下将无法运行。本节将为您介绍另一段专为在受保护工作表中实现多选功能而设计的 VBA 脚本。

VBA 代码：在下拉列表中启用多选（无重复项）

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 20240118
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim delimiter As String
    Dim TargetRange As Range
    Dim isProtected As Boolean
    Dim pswd As Variant

    Set TargetRange = Me.UsedRange ' Set your specific range here
    delimiter = ", " ' Users can change the delimiter here

    If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
    
    ' Check if sheet is protected
    isProtected = Me.ProtectContents
    If isProtected Then
        ' If protected, temporarily unprotect. Adjust or remove the password as needed.
        pswd = "yourPassword" ' Change or remove this as needed
        Me.Unprotect Password:=pswd
    End If

    On Error Resume Next
    Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then
        If isProtected Then Me.Protect Password:=pswd
        Exit Sub
    End If
    Application.EnableEvents = False

    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
    Target.Value = xValue2
    If xValue1 <> "" And xValue2 <> "" Then
        If Not (xValue1 = xValue2 Or _
                InStr(1, xValue1, delimiter & xValue2) > 0 Or _
                InStr(1, xValue1, xValue2 & delimiter) > 0) Then
            Target.Value = xValue1 & delimiter & xValue2
        Else
            Target.Value = xValue1
        End If
    End If

    Application.EnableEvents = True
    On Error GoTo 0

    ' Re-protect the sheet if it was protected
    If isProtected Then
        Me.Protect Password:=pswd
    End If
End Sub

在 Excel 下拉列表中启用多选功能，即可大幅提升工作表的功能性与灵活性。无论您熟悉 VBA 编程，还是更倾向于使用 Kutools 这类简便解决方案，都能轻松将标准下拉列表升级为动态多选工具。掌握这些技能后，您将能创建更动态、更用户友好的 Excel 文档。想深入挖掘 Excel 的强大潜能？我们的网站提供丰富教程资源，在此发现更多 Excel 技巧与窍门！

相关文章