VBA: Entfernen von Werten aus einem Mehrfachauswahlfeld

Question

Ich habe eine Seite in meiner Arbeitsmappe, in der bestimmte Zellen mehrfach ausgewählt sind. Benutzer können Werte aus einer Dropdown-Liste auswählen und sie anhängen und formatieren, um sie in unser System zu laden. Es funktioniert großartig - aber es gibt nur ein Problem. Es gibt derzeit keine Möglichkeit, einen einzelnen Wert zu entfernen. Wenn ein Benutzer den falschen Wert aus dem Dropdown auswählt, müßte er löschen und neu beginnen. Gibt es eine Möglichkeit, einzelne Werte zu entfernen? Hier ist der aktuelle Multi-Select-Code:

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rngDV As Range 
Dim oldVal As String 
Dim newVal As String 
Dim strSep As String 
Dim strSep2 As String 
Dim header As String 
Dim MatchField As Range 
Dim AnsType As Range 

Application.ScreenUpdating = False 

strSep = Chr(34) & "," & Chr(34) 
strSep2 = "," & Chr(34) 

header = Me.Cells(11, Target.Column).Value 
Set MatchField = ThisWorkbook.Worksheets("User Fields").Range("B16:B100").Find(header) 

If Not MatchField Is Nothing Then 
    Set AnsType = MatchField.Offset(0, 2) 
End If 

Application.EnableEvents = False 
On Error Resume Next 

If Target.Count > 1 Then GoTo exitHandler 

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 'cell has data validation 
    If InStr(1, AnsType, "Multiple") > 0 Then 'Determines if current column corresponds to a multi-select field 

    newVal = Target.Value 
    Application.Undo 
    oldVal = Target.Value 
    Target.Value = newVal 

    If newVal = "" Then 
     'do nothing 
    Else 
     If oldVal = "" Then 
      Target.Value = newVal 
     ElseIf InStr(1, oldVal, newVal) = 0 Then 
      If InStr(1, oldVal, Chr(34)) > 0 Then 
       Target.Value = oldVal & strSep2 & newVal & Chr(34) 
      Else 
       Target.Value = Chr(34) & oldVal & strSep & newVal & Chr(34) 
      End If 
     Else 
      Target.Value = oldVal 
     End If 
    End If 
    End If 
End If 
Application.ScreenUpdating = True 
exitHandler: 
    Application.EnableEvents = True 
Application.ScreenUpdating = True 
End Sub 

Answer 1

Sie müssen die „If“ Aussage zu entfernen, das Doppel aus dem gleichen Artikel verbietet, um es aus der Zeichenfolge zu löschen. Probieren Sie den folgenden Code aus und lassen Sie die doubles-Anweisung auskommentiert.

Private Sub Worksheet_Change(ByVal Target As Range) 
    'Updated: 2016/4/12 
    Dim xRng As Range 
    Dim xValue1 As String 
    Dim xValue2 As String 
    If Target.Count > 1 Then Exit Sub 
    On Error Resume Next 
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation) 
    If xRng Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
    If Not Application.Intersect(Target, xRng) Is Nothing Then 
     xValue2 = Target.Value 
     Application.Undo 
     xValue1 = Target.Value 
     Target.Value = xValue2 
     If xValue1 <> "" Then 
      If xValue2 <> "" Then 
'    If xValue1 = xValue2 Or _ 
'     InStr(1, xValue1, ", " & xValue2) Or _ 
        InStr(1, xValue1, xValue2 & ",") Then 
       If InStr(1, xValue1, xValue2 & ",") > 0 Then 
        xValue1 = Replace(xValue1, xValue2 & ", ", "") ' If it's in the middle with comma 
        Target.Value = xValue1 
        GoTo jumpOut 
       End If 
       If InStr(1, xValue1, ", " & xValue2) > 0 Then 
        xValue1 = Replace(xValue1, ", " & xValue2, "") ' If it's at the end with a comma in front of it 
        Target.Value = xValue1 
        GoTo jumpOut 
       End If 
       If xValue1 = xValue2 Then ' If it is the only item in string 
        xValue1 = "" 
        Target.Value = xValue1 
        GoTo jumpOut 
       End If 
       Target.Value = xValue1 & ", " & xValue2 
      End If 
jumpOut: 
     End If 
    End If 
    Application.EnableEvents = True 
End Sub