Funzione VBA Foglio di lavoro_Cambia per Excel

Ho modificato la funzione soggetto per rimuovere le selezioni esistenti riselezionandole e per rimuovere ;'s extra. Ecco il codice rivisto:

Private Sub Worksheet_Change (ByVal Target As Range)
'Aggiornato da Extendoffice 2019/11/13
'Aggiornato da Ken Gardner 2022/07/11
Dim xRng come intervallo
Dim xValue1 come stringa
Dim xValue2 come stringa
Dim semiColonCnt come numero intero
Se Target.Count > 1 Quindi esci da Sub
On Error Resume Next
Imposta xRng = Cells.SpecialCells(xlCellTypeAllValidation)
Se xRng non è niente, allora esci da Sub
Application.EnableEvents = False
'Se non Application.Intersect(Target, xRng) non è niente allora
Se Application.Intersect(Target, xRng) Allora
xValue2 = Valore.destinazione
Applicazione.Annulla
xValue1 = Valore.destinazione
Valore.destinazione = xValore2
Se xValore1 <> "" Allora
Se xValore2 <> "" Allora
Se xValore1 = xValore2 O xValore1 = xValore2 & ";" Oppure xValue1 = xValue2 & "; " Quindi ' lascia il valore se solo uno nell'elenco
xValore1 = Sostituisci(xValore1, "; ", "")
xValore1 = Sostituisci(xValore1, ";", "")
Valore.destinazione = xValore1
ElseIf InStr(1, xValue1, "; " & xValue2) Allora
xValue1 = Sostituisci(xValue1, xValue2, "") ' rimuove il valore esistente dall'elenco alla selezione ripetuta
Valore.destinazione = xValore1
ElseIf InStr(1, xValore1, xValore2 & ";") Allora
xValore1 = Sostituisci(xValore1, xValore2, "")
Valore.destinazione = xValore1
Altro
Valore.destinazione = xValore1 & "; " & xValore2
End If
Valore.destinazione = Sostituisci(Valore.destinazione, ";;", ";")
Valore.destinazione = Sostituisci(Valore.destinazione, "; ;", ";")
Se InStr(1, Target.Value, "; ") = 1 Allora ' controlla ; come primo carattere e rimuoverlo
Valore.destinazione = Sostituisci(Valore.destinazione, "; ", "", 1, 1)
End If
Se InStr(1, Target.Value, ";") = 1 Allora
Valore.destinazione = Sostituisci(Valore.destinazione, ";", "", 1, 1)
End If
semicolonnaCnt = 0
Per i = 1 A Len(Valore.Target)
If InStr(i, Target.Value, ";") Allora
semicolonCnt = semicolonCnt + 1
End If
Avanti
Se semiColonCnt = 1 Allora 'rimuovi; se ultimo carattere
Valore.destinazione = Sostituisci(Valore.destinazione, "; ", "")
Valore.destinazione = Sostituisci(Valore.destinazione, ";", "")
End If
End If
End If
End If
Application.EnableEvents = True
End Sub