Trier le contenu d'une cellule

Voilà une macro super utile, fortement inspirée de ce forum.

Sub TriCellule()
Dim I As Integer
Dim J As Integer, K As Byte
Dim Cible As String, val As String
Dim Tableau() As String

Dim aRng As Range
Dim aCell As Range

Set aRng = Selection

Dim resultat As String

For Each aCell In aRng

I = 0
J = 0
K = 0
Cible = aCell.Value & Chr(10)
val = ""
ReDim Preserve Tableau(0)

resultat = ""


For I = 1 To Len(Cible) 'extraire donnees
J = InStr(I, Cible, Chr(10))

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


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

resultat = Left(resultat, Len(resultat) - 1)


'MsgBox resultat, , "Resultat du tri alphabetique "
aCell.Value = resultat

Next aCell

End Sub