Excel下拉多选VBA代码优化：实现误选值移除功能

Hey there! Let's update your existing VBA code to not just add selected values, but also let users remove accidentally chosen ones—all while keeping the values in the same order as your dropdown list and using line breaks instead of commas.

Here's the Revised Code #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OldValue As String
    Dim NewValue As String
    Dim validationList As String
    Dim listItems As Variant
    Dim finalValues As String
    Dim i As Integer
    Dim isExists As Boolean
    
    ' Only run for specific cells: D26, D38, C4
    If Target.Address <> "$D$26" And Target.Address <> "$D$38" And Target.Address <> "$C$4" Then
        GoTo ExitSub
    End If
    
    Application.EnableEvents = False
    On Error GoTo ExitSub
    
    ' Check if the cell has validation dropdown
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        GoTo ExitSub
    End If
    
    NewValue = Target.Value
    If NewValue = "" Then
        GoTo ExitSub
    End If
    
    ' Extract dropdown options from validation source
    validationList = Target.Validation.Formula1
    validationList = Replace(validationList, "=", "") ' Remove leading = if present
    listItems = Split(validationList, ",") ' Split into array of dropdown items
    
    ' Get cell value before the latest change
    Application.Undo
    OldValue = Target.Value
    
    ' Split existing cell values into an array (using line breaks as separator)
    Dim existingItems As Variant
    If OldValue <> "" Then
        existingItems = Split(OldValue, vbNewLine)
    Else
        existingItems = Array()
    End If
    
    ' Check if the newly selected value already exists in the cell
    isExists = False
    For i = LBound(existingItems) To UBound(existingItems)
        If existingItems(i) = NewValue Then
            isExists = True
            Exit For
        End If
    Next i
    
    ' Build final value list matching dropdown order
    finalValues = ""
    For i = LBound(listItems) To UBound(listItems)
        ' Include item if:
        ' 1. It's the new value and wasn't present before, OR
        ' 2. It was present before and isn't the value being removed
        If (listItems(i) = NewValue And Not isExists) Or _
           (listItems(i) <> NewValue And IsInArray(listItems(i), existingItems)) Then
            If finalValues <> "" Then
                finalValues = finalValues & vbNewLine
            End If
            finalValues = finalValues & listItems(i)
        End If
    Next i
    
    Target.Value = finalValues
    
ExitSub:
    Application.EnableEvents = True
End Sub

' Helper function to check if a value exists in an array
Private Function IsInArray(searchVal As String, arr As Variant) As Boolean
    Dim i As Integer
    IsInArray = False
    For i = LBound(arr) To UBound(arr)
        If arr(i) = searchVal Then
            IsInArray = True
            Exit For
        End If
    Next i
End Function

Key Improvements Explained #

• Toggle Selection Behavior: Now selecting an already-present value removes it from the cell, fixing accidental clicks instantly.
• Dropdown Order Preservation: The final cell content always matches the order of your original dropdown list—no random reordering when adding/removing values.
• Clean Line Break Formatting: Keeps each value on its own line, just like your initial setup, no commas involved.
• Robust Error Handling: Includes checks for valid dropdown cells and empty inputs to avoid runtime errors.
• Helper Function: The IsInArray function simplifies checking if a value is already present in the cell, making the code cleaner and easier to maintain.

Quick Setup Steps #

1. Replace your existing Worksheet_Change subroutine with this code (make sure it's saved in the worksheet module, not a standard module).
2. Confirm your target cells (D26, D38, C4) have a dropdown validation list with comma-separated options.
3. Test it out: select values to add them, select an existing value to remove it—everything stays organized and in order!

内容的提问来源于stack exchange，提问作者lyng