vba - 使用宏在 Excel 中进行多选，如何取消选择选择

Question

我需要使用 MultiSelect 下拉菜单创建启用宏的 excelsheet。

用户选择下拉列表之一，然后用逗号(，)分隔将值附加到单元格中。

如果用户再次选择已选择的值，则应将其从列表中删除。

通过以下代码，我能够实现它的第一部分，但无法实现第二部分。

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String
    Dim Newvalue As String
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Target.Address = "$D$2" Then
      If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        GoTo Exitsub
      Else: If Target.Value = "" Then GoTo Exitsub Else
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
          If Oldvalue = "" Then
            Target.Value = Newvalue
          Else
            If InStr(1, Oldvalue, Newvalue) = 0 Then
                Target.Value = Oldvalue & ", " & Newvalue
          Else:
            Target.Value = Oldvalue
          End If
        End If
      End If
    End If
    Application.EnableEvents = True
    Exitsub:
    Application.EnableEvents = True
    End Sub

如何实现第 2 部分？请建议。

Answer 1

你可以替代:

If InStr(1, Oldvalue, Newvalue) = 0 Then
    Target.Value = Oldvalue & ", " & Newvalue

和:

    If InStr(1, Oldvalue, Newvalue) = 0 Then
        Target.Value = Oldvalue & ", " & Newvalue
    Else
        Target.Value = Replace(Target.Value, Newvalue, "") ' remove value from list
        If Right(Target.Value, 1) = "," Then 'if removed value was the last value of the list
            Target.Value = Left(Target.Value, Len(Target.Value) - 1) ' remove ending comma
        ElseIf Left(Target.Value, 1) = "," Then 'if removed value was the first value of the list
            Target.Value = Mid(Target.Value, 2) ' remove leading comma
        Else ' removed value was in the middle of the list
            Target.Value = Replace(Target.Value, ",,", "") ' remove double comma
        End If
    End If