Supprimer doublons dans une même cellule?

Bonjour est il possible de supprimer des doublons dans une même cellule?

Exemple:

0606070606;0606060606;0606070606 devrait donner=0606060606;0606070606

0609060606;0609060606 devrait donner=0609060606

Merci

bonjour,

le résultat doit s'incrire dans la même cellule ? Alors cela sera avec VBA, non ?

Sub SansDoublons()
     Dim c,aA,i,j,s
     Set c = Range("A1:A10")
     aA = c.Value

     For i = 1 To UBound(aA)
          If Len(aA(i, 1)) > 0 Then
               s = ";"
               sp = Split(aA(i, 1), ";")     'spliter
               For j = 0 To UBound(sp)
                    If InStr(1, s, sp(j), 1) = 0 Then s = s & sp(j) & ";"     'no doublons
               Next
               aA(i, 1) = Mid(s, 2, Len(s) - 2)     'eliminer le ";" prefix et suffix
          End If
     Next

     c.Value = aA

End Sub

Si c'est dans la cellule suivante ça me va bien ;)

Bonjour,

On peut aussi créer une fonction personnalisée et l'utiliser dans la colonne voisine
Code à copier dans un Module Standard :

Function sansDoublons(source As Range)
    Set dic = CreateObject("scripting.dictionary")
    tablo = Split(source.Value, ";")
    For i = 0 To UBound(tablo)
        dic(tablo(i)) = ""
    Next i
    sansDoublons = Join(dic.keys, ";")
End Function

Ensuite, en B1, il reste à écrire

=sansDoublons(A1)

@U.Milité, Furioussci, le fil,

j'avais aussi pensé a un dictionaire, mais je pensais que se serait plus vite avec instr (sans preuve).

il y avait encore un erreur dans ma macro (qu'on peut aussi changer en fonction personnalisée)

Sub SansDoublons()
     Dim c, aA, i, j, s
     Set c = Range("A1:A10")
     aA = c.Value

     For i = 1 To UBound(aA)
          If Len(aA(i, 1)) > 0 Then
               s = ";"
               sp = Split(aA(i, 1), ";")     'spliter
               For j = 0 To UBound(sp)
                    If InStr(1, s, ";" & sp(j) & ";", 1) = 0 Then s = s & sp(j) & ";"     'no doublons
               Next
               aA(i, 1) = Mid(s, 2, Len(s) - 2)     'eliminer le ";" prefix et suffix
          End If
     Next

     c.Offset(, 1).Value = aA

End Sub

Bonjoiur,
Avec Excel 365, 2021, cela pourrait être :

Cdlt.

Avec Excel 2007 la formule fonctionne t'elle?

Merci Umilité "ça fonctionne au top"

bonjour,

alors vous devez mettre à jour votre version Excel de 2007 > 2021/365. Cela est important pour vos questions suivantes.

Bonjour tout le monde,

@BsAlv

BsAlv a écrit :

alors vous devez mettre à jour votre version Excel de 2007 > 2021/365. Cela est important pour vos questions suivantes.

Il doit y avoir erreur : furiousxsi n'a pas changé de version, à ma connaissance !?

je possède le 2007.

je n’ai pas d’autres version d’excel 👍

sorry, mauvais interprétation de Merci Umilité "ça fonctionne au top" et moi, je pensais que c'était pour la formule 2021/365 de Jean-Eric

Pas de Soucis BsAlv