代码之家 › 专栏 › 技术社区 › Red Boy

使用宏在Excel中进行多重选择,如何取消选择所选内容

excel-vba vba excel

1

Red Boy · 技术社区 · 6 年前

我需要创建启用宏的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 回复 | 直到 6 年前

1

0

user9817739 6 年前

  Dim substrings() As String
    substrings = Split(Oldvalue, ", ")
    Target.Value = ""
    Dim i As Integer
    For i = LBound(substrings) To UBound(substrings)
        If Not (substrings(i) = Newvalue) Then
          Target.Value = Target.Value & ", " & substrings(i)
        End If
    Next i

2

1

DisplayName 6 年前

您可以替换:

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