Microsoft 365 Tris et suppression de doublon dans une cellule

Diane272727

XLDnaute Junior
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 :)
 
Solution
Bonjour Diane, Eric, Simply,
Je n'avais pas précisé mais effectivement je voulais une formule.
Une formule perso ? 😅
VB:
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...

Eric KERGRESSE

XLDnaute Occasionnel
Bonjour à tous,

Si VBA autorisé :
VB:
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
 

Pièces jointes

  • Diane272727 Trier dans cellule sans doubles.xlsm
    17.2 KB · Affichages: 0

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Diane, Eric, Simply,
Je n'avais pas précisé mais effectivement je voulais une formule.
Une formule perso ? 😅
VB:
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
 

Pièces jointes

  • Diane.xlsm
    14.1 KB · Affichages: 1

fanch55

XLDnaute Barbatruc
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 :
VB:
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 :
1699523872824.png
 
Dernière édition:

Diane272727

XLDnaute Junior
Bonjour Diane, Eric, Simply,

Une formule perso ? 😅
VB:
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é

XLDnaute Barbatruc
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
VB:
=JOINDRE.TEXTE(",";;TRIER(UNIQUE(FRACTIONNER.TEXTE(A1;;", "))))
Cordialement
 

dysorthographie

XLDnaute Accro
bonjour,
pas de raison que j'y mette pas mon grain de sel!
VB:
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
 

Discussions similaires

Réponses
5
Affichages
311

Statistiques des forums

Discussions
313 327
Messages
2 097 210
Membres
106 876
dernier inscrit
ceyquem