J'ai modifié la fonction sujet pour supprimer les sélections existantes en les re-sélectionnant et pour supprimer les ;'s supplémentaires. Voici le code révisé :

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
'Mis à jour par Extendoffice 2019/11/13
'Mise à jour par Ken Gardner 2022/07/11
Dim xRng comme plage
Dim xValue1 en tant que chaîne
Dim xValue2 en tant que chaîne
Dim point-virgule en tant qu'entier
Si Target.Count> 1, puis quitter le sous-marin
On Error Resume Next
Définir xRng = Cells.SpecialCells(xlCellTypeAllValidation)
Si xRng n'est rien, quittez Sub
Application.EnableEvents = False
'Si ce n'est pas Application.Intersect(Target, xRng) n'est rien alors
Si Application.Intersect(Target, xRng) Alors
xValeur2 = Cible.Valeur
Application.Annuler
xValeur1 = Cible.Valeur
Cible.Valeur = xValeur2
Si xValeur1 <> "" Alors
Si xValeur2 <> "" Alors
Si xValeur1 = xValeur2 Ou xValeur1 = xValeur2 & ";" Ou xValeur1 = xValeur2 & "; " Alors ' laissez la valeur si une seule dans la liste
xValeur1 = Remplacer(xValeur1, "; ", "")
xValeur1 = Remplacer(xValeur1, ";", "")
Cible.Valeur = xValeur1
SinonSi InStr(1, xValeur1, "; " & xValeur2) Alors
xValue1 = Replace(xValue1, xValue2, "") ' supprime la valeur existante de la liste lors de la répétition de la sélection
Cible.Valeur = xValeur1
SinonSi InStr(1, xValeur1, xValeur2 & ";") Alors
xValeur1 = Remplacer(xValeur1, xValeur2, "")
Cible.Valeur = xValeur1
autre
Cible.Valeur = xValeur1 & "; " & xValeur2
Si fin
Cible.Valeur = Remplacer(Cible.Valeur, ";;", ";")
Target.Value = Remplacer(Target.Value, "; ;", ";")
Si InStr(1, Target.Value, "; ") = 1 Alors ' vérifie ; comme premier caractère et supprimez-le
Cible.Valeur = Remplacer(Cible.Valeur, "; ", "", 1, 1)
Si fin
Si InStr(1, Target.Value, ";") = 1 Alors
Cible.Valeur = Remplacer(Cible.Valeur, ";", "", 1, 1)
Si fin
point-virgule = 0
Pour i = 1 To Len(Target.Value)
Si InStr(i, Target.Value, ";") Alors
point-virgule = point-virgule + 1
Si fin
Suivant i
Si point-virgule = 1 Alors ' supprimer ; si dernier caractère
Cible.Valeur = Remplacer(Cible.Valeur, "; ", "")
Cible.Valeur = Remplacer(Cible.Valeur, ";", "")
Si fin
Si fin
Si fin
Si fin
Application.EnableEvents = True
End Sub