Tri alphabétique d'une cellule multivaluée

Bonjour,

Je souhaiterai pouvoir trier alphabétiquement le contenu d'une cellule multivaluée : mots séparés par une virgule et un espace.

Il s'agit de la colonne "Synonymes" (fichier ci-joint).

Je suis totalement novice dans les macros.

J'ai trouvé les macros suivantes sur d'autres forums mais je suis embêtée dans leur utilisation.

Sub ExtractionEtTriCellule()
Dim I As Integer
Dim J As Byte, K As Byte
Dim Cible As String, Val As String
Dim Tableau() As String

Cible = Range("A1") & ","
For I = 1 To Len(Cible) 'extraire donnees
J = InStr(I, Cible, ",")
K = K + 1
ReDim Preserve Tableau(K - 1)
Tableau(K - 1) = LTrim(Mid(Cible, I, J - I))
I = I + Len(Mid(Cible, I, J - I))
Next

For I = LBound(Tableau) To UBound(Tableau) 'trier
J = I
For K = J + 1 To UBound(Tableau)
If Tableau(K) <= Tableau(J) Then J = K
Next K
If I <> J Then
Val = Tableau(J): Tableau(J) = Tableau(I): Tableau(I) = Val
End If
Next I

Dim resultat As String
For I = 1 To UBound(Tableau) + 1
resultat = resultat & Tableau(I - 1) & Chr(10)
Next

MsgBox resultat, , "Resultat du tri alphabetique "
End Sub

Cette macro ne fonctionne que sur la cellule C2.

Je souhaiterai que la macro fonctionne sur toutes les cellules d'une colonne donnée.

J'ai donc essayé d'utiliser cette autre macro qui était proposée :

Sub TriCellule()
'
' TriCellule Macro
' La fonction Split transforme une chaîne en tableau
' La fonction Join fait l'inverse
'
Dim Chn As String, Tri As Boolean, I As Integer, Tmp As String
Chn = ActiveCell.Text
If Chn = "" Then Exit Sub
TbChn = Split(Chn, ",")
If UBound(TbChn) > 0 Then
Do
Tri = False
For I = 1 To UBound(TbChn)
If TbChn(I) < TbChn(I - 1) Then
Tmp = TbChn(I - 1)
TbChn(I - 1) = TbChn(I)
TbChn(I) = Tmp
Tri = True
End If
Next
Loop While Tri = True
Chn = Join(TbChn, ",")
ActiveCell.Value = Chn
End If
'
End Sub

La macro ne fonctionne que sur la cellule active.

Je souhaiterai que la macro fonctionne sur ma colonne "Synonymes" complète.

Cette colonne peut contenir des cellules vides, et des cellules ne contenant pas le séparateur ",".

Merci d'avance pour votre aide.

Cordialement,

Lydia

Bonjour,

une proposition pour trier le contenu des cellules de la colonne C (3)

Sub aargh()
    With ActiveSheet
        dl = .Cells(Rows.Count, 3).End(xlUp).Row
        For i = 2 To dl
            t = Split(.Cells(i, 3), ", ")
            For i1 = LBound(t) To UBound(t) - 1
                For i2 = i1 + 1 To UBound(t)
                    If Trim(t(i1)) > Trim(t(i2)) Then
                        temp = t(i1): t(i1) = t(i2): t(i2) = temp
                    End If
                Next i2
            Next i1
            .Cells(i, 3) = Join(t, ", ")
        Next i
    End With
End Sub

Bonjour h2so4,

Merci beaucoup pour cette macro qui fait clairement le boulot !

Tu m'enlèves une sacrée épine du pied.

Actuellement la macro trie seulement si la première lettre est en majuscule.

Y'a-t-il un moyen simple pour que la macro trie indifféremment selon la casse ?

Je te joins, pour exemple, le fichier contenant les valeurs en minuscules.

Merci d'avance,

Cordialement,

Lydia

bonjour,

voici

Option Compare Text
Sub aargh()
    With ActiveSheet
        dl = .Cells(Rows.Count, 3).End(xlUp).Row
        For i = 2 To dl
            t = Split(.Cells(i, 3), ", ")
            For i1 = LBound(t) To UBound(t) - 1
                For i2 = i1 + 1 To UBound(t)
                    If Trim(t(i1)) > Trim(t(i2)) Then
                        temp = t(i1): t(i1) = t(i2): t(i2) = temp
                    End If
                Next i2
            Next i1
            .Cells(i, 3) = Join(t, ", ")
        Next i
    End With
End Sub

Bonjour h2so4,

Merci beaucoup, c'est parfait !

Je marque le ticket comme résolu, et encore merci pour ta rapidité et ton efficacité.

Cordialement,

Lydia