Microsoft 365 Tris et suppression de doublon dans une cellule

[Diane272727]

Bonjour ,
Je voudrais trier dans une cellule les données séparées par des virgules et supprimer les doublons.
Les données vont de 0 à 9.

Exemple :
9, 8, 9, 7, 8, 1
Résultat :
1, 7, 8, 9

Est il possible de faire cela et comment est il possible de le faire ?
Merci beaucoup

 

[Simply]

Bonjour

=JOINDRE.TEXTE(", ";;TRI(UNIQUE(DIVIDI.TESTO(A1;;", "))))

 

[Eric KERGRESSE]

Bonjour à tous,

Si VBA autorisé :

Function TrierSansDoublons(ByVal Chaine As String) As String

Dim I As Integer, J As Integer
Dim TabChaine As Variant, ListeCle As Variant, StrTemp As Variant
Dim MonDico As Object

    If InStr(1, Chaine, ",", vbTextCompare) > 0 Then
      
       Set MonDico = CreateObject("Scripting.Dictionary")
       TabChaine = Split(Chaine, ",")
       For I = LBound(TabChaine) To UBound(TabChaine)
        
            If Not MonDico.Exists(Trim(TabChaine(I))) Then
            MonDico.Add Trim(TabChaine(I)), Trim(TabChaine(I))
            End If
       Next I
      
       ListeCle = MonDico.Keys
       For I = LBound(ListeCle) To UBound(ListeCle)
           For J = LBound(ListeCle) To UBound(ListeCle)
                    If Val(ListeCle(I)) < Val(ListeCle(J)) Then
                       StrTemp = ListeCle(I)
                       ListeCle(I) = ListeCle(J)
                       ListeCle(J) = StrTemp
                    End If
           Next J
       Next I
      
       TrierSansDoublons = Join(ListeCle, ", ")
       Set MonDico = Nothing
    
    End If

End Function

 

[Diane272727]

Bonjour

=JOINDRE.TEXTE(", ";;TRI(UNIQUE(DIVIDI.TESTO(A1;;", "))))

Merci. Je n'avais pas précisé mais effectivement je voulais une formule.
Par contre cette formule me renvoi "#NOM?". Savez vous pourquoi ?

 

[sylvanu]

Bonjour Diane, Eric, Simply,

Je n'avais pas précisé mais effectivement je voulais une formule.

Une formule perso ?

Function TriDiane(C$)
    Dim T, i%, j%
    C = Replace(C, " ", "") ' Suppression espaces
    T = Split(C, ",")       ' Séparation des champs
    For i = 0 To UBound(T)  ' Suppression doublons
        Car = T(i)
        For j = i + 1 To UBound(T):
            If T(j) = Car Then T(j) = ""
        Next j
    Next i
    For i = 0 To UBound(T)  ' Tri croissant
        For j = i + 1 To UBound(T)
            If T(i) > T(j) Then Buffer = T(i): T(i) = T(j): T(j) = Buffer
        Next j
    Next i
    For i = 0 To UBound(T)  ' Reconstitution chaine
        If T(i) <> "" Then TriDiane = TriDiane & "," & T(i)
    Next i
    TriDiane = Mid(TriDiane, 2)
End Function

 

[fanch55]

Merci. Je n'avais pas précisé mais effectivement je voulais une formule.
Par contre cette formule me renvoi "#NOM?". Savez vous pourquoi ?

DIVIDI.TESTO = TEXTSPLIT

sinon un autre genre de fonction à mettre dans un module :

Function TriSd(CString As String)
Dim Alist As Object, Clist As Variant, numeric As Boolean
    Set Alist = CreateObject("System.Collections.ArrayList")
        Clist = Split(CString, ",")
      ' Première Passe pour déterminer le type de valeurs (important pour le tri)
        For Each C In Clist
            If Not IsNumeric(C) Then
                numeric = False
                Exit For
            End If
        Next
      ' Deuxième Passe pour charger l'arraylist
        For Each C In Clist
            If numeric Then C = Val(C) Else C = CStr(Trim(C))
            If Not Alist.Contains(C) Then Alist.Add C
        Next
        Alist.Sort
    TriSd = Join(Alist.ToArray, ",")
End Function

A appeler ainsi :

 

[Diane272727]

DIVIDI.TESTO = TEXTSPLIT

J'ai le meme message

 

[fanch55]

J'ai le meme message

TEXTSPLIT ou plutôt FRACTIONNER.TEXTE est une fonction existant uniquement sur Office365,
même pas dans Excel 2021 ... ( merci la logique commerciale microsoft ..... )

 

[Diane272727]

curieux car ça ne marche pas chez moi, et je suis sur o365

 

[Diane272727]

Bonjour Diane, Eric, Simply,

Une formule perso ?

Function TriDiane(C$)
    Dim T, i%, j%
    C = Replace(C, " ", "") ' Suppression espaces
    T = Split(C, ",")       ' Séparation des champs
    For i = 0 To UBound(T)  ' Suppression doublons
        Car = T(i)
        For j = i + 1 To UBound(T):
            If T(j) = Car Then T(j) = ""
        Next j
    Next i
    For i = 0 To UBound(T)  ' Tri croissant
        For j = i + 1 To UBound(T)
            If T(i) > T(j) Then Buffer = T(i): T(i) = T(j): T(j) = Buffer
        Next j
    Next i
    For i = 0 To UBound(T)  ' Reconstitution chaine
        If T(i) <> "" Then TriDiane = TriDiane & "," & T(i)
    Next i
    TriDiane = Mid(TriDiane, 2)
End Function

ça marche niquel du coup en vba. Merci beaucoup. Je clos le sujet. Bonne journée à tous et merci à tous

 

[Efgé]

Bonjour
En fait la solution de @Simply est la bonne en utilisant les bons noms de formules 365 FR
TRIER et pas TRI
FRACTIONNER.TEXTE et pas DIVIDI.TESTO comme indiqué précédemment

=JOINDRE.TEXTE(",";;TRIER(UNIQUE(FRACTIONNER.TEXTE(A1;;", "))))

Cordialement

 

[dysorthographie]

bonjour,
pas de raison que j'y mette pas mon grain de sel!

Sub test()
Debug.Print TrieAlphaPasDoublon("9,11 ,9,8,9,7,8,1")
End Sub

Function TrieAlphaPasDoublon(Value As String) As String
Const adInteger = 3
Dim T, I As Integer: T = Split(Value & ",", ",")
With CreateObject("ADODB.Recordset")
        .Fields.Append "KRY", adInteger
        .Open
        For I = LBound(T) To UBound(T) - 1
            .Filter = "KRY=" & Trim(T(I))
            If .EOF Then .AddNew "KRY", Trim(T(I))         
        Next
        .Update
        .Filter = ""
        .MoveFirst
       .Sort = "KRY"
      TrieAlphaPasDoublon = .GetString(, , , ",")
       TrieAlphaPasDoublon = Left(TrieAlphaPasDoublon, Len(TrieAlphaPasDoublon) - 1)   
    .Close
End With
End Function

 

[fanch55]

Bonjour
En fait la solution de @Simply est la bonne en utilisant les bons noms de formules 365 FR
TRIER et pas TRI
FRACTIONNER.TEXTE et pas DIVIDI.TESTO comme indiqué précédemment

=JOINDRE.TEXTE(",";;TRIER(UNIQUE(FRACTIONNER.TEXTE(A1;;", "))))

Cordialement

Un retour de Diane ?