Supprimer les doublons dans une même cellule

[jozerebel]

Bonjour à tous,

J'ai des cellules qui contiennent parfois plusieurs fois la même chose...

Par exemple :
0701144215+0802147947+0802147947+0802147947

Je souhaiterais pouvoir tester cette cellule afin de n'obtenir que :


0701144215+0802147947

C'est à dire supprimer les données qui se retrouvent plusieurs fois. Toutes les chaines de caractères sont séparées par "+"

Ou sinon, si l'on peut modifier ce code VBA pour qu'il affiche directement ce que je souhaite:

Function RechTous(v, champRech As Range, ChampRetour As Range)
a = champRech
temp = ""
For i = 1 To champRech.Count
If a(i, 1) = v Then
temp = temp & ChampRetour(i) & "+"
End If
Next i
RechTous = Left(temp, Len(temp) - 1)
End Function

Sachant que mon résultat est "Champ retour".

En fait le code devrait tester tous les champs retour et ne les retourner qu'une fois...

J'espère avoir été compréhensible...

D'avance merci pour votre aide.

 

[BOISGONTIER]

Re : Supprimer les doublons dans une même cellule

Bonsoir,

Voir PJ

Function SansDoublon(c, sep)
a = Split(Application.Trim(c), sep)
Set mondico = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(a): mondico.Item(a(i)) = 1: Next i
SansDoublon = Join(mondico.keys, sep)
End Function

JB
Formation Excel VBA JB

 

[jozerebel]

Re : Supprimer les doublons dans une même cellule

Merci bcp encore une fois!

Bonne soirée!

 

[job75]

Re : Supprimer les doublons dans une même cellule

Bonjour jozerebel, JB,

Loin d'être aussi à l'aise que JB avec les objets Scripting.Dictionary, j'avais fait ceci :

Function SupDoublon$(txt$)
Dim s, u%, i%, j%
s = Split(txt, "+")
u = UBound(s)
For i = 0 To u
  For j = i + 1 To u
    If s(i) = s(j) Then s(j) = ""
  Next
Next
For i = 0 To u
  SupDoublon = SupDoublon & IIf(s(i) = "" Or i = 0, "", "+") & s(i)
Next
End Function

Fichier joint.

A+