Funkce VBA Worksheet_Change pro excel

Upravil jsem funkci předmětu, abych odstranil existující výběry při jejich opětovném výběru a odstranil nadbytečné ;. Zde je upravený kód:

Soukromá dílčí tabulka_Změna (ByVal Target As Range)
'Aktualizováno Extendoffice 2019/11/13
'Aktualizováno Kenem Gardnerem 2022/07/11
Dim xRng As Range
Dim xValue1 jako řetězec
Dim xValue2 jako řetězec
Ztlumit semiColonCnt jako celé číslo
Pokud Target.Count > 1, pak Exit Sub
On Error Resume Next
Nastavit xRng = Cells.SpecialCells(xlCellTypeAllValidation)
Pokud xRng není nic, pak Exit Sub
Application.EnableEvents = False
'Pokud ne Application.Intersect(Target, xRng) není nic
If Application.Intersect(Target, xRng) Then
xValue2 = Target.Value
Aplikace. Zpět
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Pak
If xValue2 <> "" Pak
Pokud xValue1 = xValue2 Nebo xValue1 = xValue2 & ";" Nebo xValue1 = xValue2 & "; " Potom ' ponechte hodnotu, pokud je v seznamu pouze jedna
xValue1 = Nahradit(xValue1, "; ", "")
xValue1 = Nahradit(xValue1, ";", "")
Target.Value = xValue1
ElseIf InStr(1, xValue1, "; " & xValue2) Potom
xValue1 = Replace(xValue1, xValue2, "") ' odstraní existující hodnotu ze seznamu při opakovaném výběru
Target.Value = xValue1
ElseIf InStr(1, xValue1, xValue2 & ";") Potom
xValue1 = Nahradit(xValue1, xValue2, "")
Target.Value = xValue1
Jiný
Target.Value = xValue1 & ";" & xValue2
End If
Target.Value = Replace(Target.Value, ";;", ";")
Target.Value = Replace(Target.Value, "; ;", ";")
If InStr(1, Target.Value, "; ") = 1 Then ' check for ; jako první znak a odstraňte jej
Target.Value = Replace(Target.Value, "; ", "", 1, 1)
End If
Pokud InStr(1, Target.Value, ";") = 1 Pak
Target.Value = Replace(Target.Value, ";", "", 1, 1)
End If
středníkCnt = 0
Pro i = 1 do délky (cílová.hodnota)
If InStr(i, Target.Value, ";") Pak
semiColonCnt = semiColonCnt + 1
End If
Příště já
If semiColonCnt = 1 Then ' remove ; pokud je poslední znak
Target.Value = Replace(Target.Value, "; ", "")
Target.Value = Replace(Target.Value, ";", "")
End If
End If
End If
End If
Application.EnableEvents = True
End Sub