Ich habe die Betrefffunktion geändert, um vorhandene Auswahlen beim erneuten Auswählen zu entfernen und zusätzliche ;'s zu entfernen. Hier ist der überarbeitete Code:

Private Sub Worksheet_Change (ByVal-Ziel als Bereich)
'Aktualisiert von Extendoffice 2019/11/13
'Aktualisiert von Ken Gardner am 2022
Dimmen Sie xRng als Bereich
Dim xValue1 als Zeichenfolge
Dim xValue2 als Zeichenfolge
Dim semiColonCnt als ganze Zahl
Wenn Target.Count > 1, dann Sub verlassen
On Error Resume Next
Setze xRng = Cells.SpecialCells(xlCellTypeAllValidation)
Wenn xRng nichts ist, dann beenden Sie Sub
Application.EnableEvents = Falsch
'If Not Application.Intersect(Target, xRng) Is Nothing Then
Wenn Application.Intersect(Target, xRng) Dann
xWert2 = Ziel.Wert
Anwendung.Rückgängig
xWert1 = Ziel.Wert
Zielwert = xWert2
Wenn xWert1 <> "" Dann
Wenn xWert2 <> "" Dann
Wenn xWert1 = xWert2 oder xWert1 = xWert2 & ";" Oder xWert1 = xWert2 & "; " Dann 'belassen Sie den Wert, wenn nur einer in der Liste ist
xWert1 = Ersetzen(xWert1, "; ", "")
xWert1 = Ersetzen(xWert1, ";", "")
Zielwert = xWert1
ElseIf InStr(1, xWert1, "; " & xWert2) Then
xValue1 = Replace(xValue1, xValue2, "") 'entfernt vorhandenen Wert aus der Liste bei wiederholter Auswahl
Zielwert = xWert1
ElseIf InStr(1, xWert1, xWert2 & ";") Then
xWert1 = Ersetzen(xWert1, xWert2, "")
Zielwert = xWert1
sonst
Zielwert = xWert1 & "; " & xWert2
End If
Ziel.Wert = Ersetzen(Ziel.Wert, ";;", ";")
Ziel.Wert = Ersetzen(Ziel.Wert, "; ;", ";")
If InStr(1, Target.Value, "; ") = 1 Then ' check for ; als erstes Zeichen und entfernen Sie es
Ziel.Wert = Ersetzen(Ziel.Wert, "; ", "", 1, 1)
End If
If InStr(1, Target.Value, ";") = 1 Then
Ziel.Wert = Ersetzen(Ziel.Wert, ";", "", 1, 1)
End If
semiColonCnt = 0
Für i = 1 zu Len(Zielwert)
If InStr(i, Target.Value, ";") Then
semiColonCnt = semiColonCnt + 1
End If
Weiter ich
If semiColonCnt = 1 Then 'remove; wenn letztes Zeichen
Ziel.Wert = Ersetzen(Ziel.Wert, "; ", "")
Ziel.Wert = Ersetzen(Ziel.Wert, ";", "")
End If
End If
End If
End If
Application.EnableEvents = Wahr
End Sub