如果從驗證列表中刪除值，如何從下拉列表中刪除值

Question

我在同一個工作簿中有 2 張表，一張是數據表，第二張表包含數據驗證值。 從單元格（在數據表中）（包含數據驗證）中刪除值時，我遇到了問題。 問題是當我嘗試從驗證列表中刪除值時，沒有從單元格中刪除相同的值。 （見屏幕截圖）“例如，如果我想從驗證列表中刪除志願者姓名，則該值不會從數據表中的單元格中刪除（屏幕截圖中突出顯示的單元格）。”

我編寫了一個 vba 代碼來在同一個單元格中添加多個值，用逗號分隔。 如果有人幫助我解決這個問題，我將不勝感激。 我的 VBA 代碼如下：

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim lUsed As Long
    If Target.Count > 1 Then GoTo exitHandler

    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler

    If rngDV Is Nothing Then GoTo exitHandler

    If Intersect(Target, rngDV) Is Nothing Then
    'do nothing
    Else
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal
    If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or 
    Target.Column = 7 Or Target.Column = 8 _
                       Or Target.Column = 9 Or Target.Column = 11 Then
                    
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        lUsed = InStr(1, oldVal, newVal)
        If lUsed > 0 Then
            If Right(oldVal, Len(newVal)) = newVal Then
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
            Else
                Target.Value = Replace(oldVal, newVal & ", ", "")
            End If
        Else
            Target.Value = oldVal _
              & ", " & newVal
        End If
        
        End If
        End If
        End If
        End If

        exitHandler:
        Application.EnableEvents = True
        End Sub

您可以從以下鏈接中找到工作表：（ show1 Sheet 是數據表， Validation Fields包含下拉值）

Excel表

謝謝

Answer 1

這段代碼對我有用：

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const SEP As String = ","
    Dim c As Range, NewValue As String, OldValue As String, arr, v, lst, removed As Boolean

    On Error GoTo Exitsub

    If Target.CountLarge > 1 Then Exit Sub '<< only handling single-cell changes

    Select Case Target.Column
        Case 3, 4, 5, 6, 7, 8, 9, 11
            Set c = Target
        Case Else: Exit Sub
    End Select
    
    If Len(c.Value) > 0 And Not c.Validation Is Nothing Then

        Application.EnableEvents = False
        NewValue = c.Value
        Application.Undo
        OldValue = c.Value

        If OldValue = "" Then
            c.Value = NewValue
        Else
            arr = Split(OldValue, SEP)
            'loop over previous list, removing newvalue if found
            For Each v In arr
                If Trim(CStr(v)) = NewValue Then
                    removed = True
                Else
                    lst = lst & IIf(lst = "", "", SEP) & v
                End If
            Next v
            'add the new value if we didn't just remove it
            If Not removed Then lst = lst & IIf(lst = "", "", SEP) & NewValue
            c.Value = lst
        End If
    End If    'has validation and non-empty
    
Exitsub:
    If Err.Number <> 0 Then MsgBox Err.Description
    Application.EnableEvents = True
End Sub