Tri numérique par ordre croissant à l'intérieur d'une cellule

Bonjour
Essayez ceci, les valeurs sont dans la colonne A à partir de la ligne 1

Sub TriCellules()
    Application.ScreenUpdating = False
    On Error Resume Next
    DerLig = [A100000].End(xlUp).Row
    For i = 1 To DerLig
        Mot = Cells(i, 1)
        NbrCar = Len(Mot)
        For K = 1 To NbrCar
            A = 1
            B = 2
            For j = 1 To NbrCar
                Deb = Left(Mot, A - 1)
                Fin = Right(Mot, NbrCar - B)
                ValA = Mid(Mot, A, 1)
                ValB = Mid(Mot, B, 1)
                If ValB < ValA Then
                    Temp = ValA
                    ValA = ValB
                    Mot = Deb & ValA & Temp & Fin
                End If
                A = B
                B = B + 1
                If B > NbrCar Then GoTo Suivant1
            Next j
Suivant1:
        Next K
Suivant:
        Cells(i, 1) = Mot
    Next i
End Sub

Cdlt

Bonjour,

Comme tu ne l'as pas indiqué, je fais cette supposition :
ta première chaîne numérique est en B2.

Le code VBA ci-dessous fait ce que tu demandes pour
ces 2 autres suppositions :

1) Un chiffre n'apparaît qu'une seule fois dans une série
(donc PAS de répétition du même chiffre).

2) La longueur de la série est de 7 chiffres maximum
(quand chacun des chiffres y est présent).

============================================

ATTENTION

Si ces 2 suppositions ne sont pas correctes,
alors le code VBA n'est PAS VALABLE !

-------------------------------------------------------------------------------

Dans ce cas, tu dois répondre à ceci :

a) Est-ce que la longueur d'une série peut dépasser 7 caractères ?
Note que dans ce cas, un même chiffre est forcément répété.

b) Est-ce qu'un même chiffre peut être répété, avec en même temps
une longueur de série maximum de 7 caractères ?

============================================

Voici le code VBA pour les suppositions 1) et 2) :

Option Explicit

Sub TriChaînes()
  Dim chn1 As String, chn2 As String, dv As Long, i As Byte
  Application.ScreenUpdating = False: ActiveSheet.Unprotect
  With [B2]
    Do While Not IsEmpty(.Offset(dv))
      chn1 = .Offset(dv): chn2 = ""
      For i = 49 To 55
        If InStr(chn1, Chr$(i)) > 0 Then chn2 = chn2 & i - 48
      Next i
      .Offset(dv, 1) = chn2: dv = dv + 1
    Loop
  End With
  ActiveSheet.Protect
End Sub

Cordialement.  😊
 

Bonjour,

Essaie le code ci-dessous (la plage PL est à adapter à ton cas) fait de deux procédures :

Sub Macro1()
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim L As Byte 'déclare la variable L (Longueur)
Dim TC() As Variant 'déclare la variable TC (Tableau des Chiffres)
Dim I As Byte 'déclare la variable I (Incrément)
Dim V As String 'déclare la variable V (Valeur)

Set PL = Range("A1:A" & Range("A" & Application.Rows.Count).End(xlUp).Row) 'définit la plage PL (à adapter à ton cas)
For Each CEL In PL 'boucle 1 : sur toutes les cellules CEL de la plage PL
    L = Len(CEL.Value) 'definit la longueur L
    ReDim Preserve TC(1 To L) 'redimensionne le tableau des chiffres TC
    For I = 1 To L 'boucle 2 : sur tous les chiffres de la cellue CEL
        TC(I) = Mid(CEL.Value, I, 1) 'récupère dans le tableau TC le chiffre de la boucle
    Next I 'prochain chiffre de la boucle (le nombre est maintenant stocké dans un tableau de L chiffres)
    Call tri(TC, LBound(TC), UBound(TC)) 'lance la procédure de tri du tableau TC
    For I = 1 To L 'boucle 3 : sur tous les chiffres du tableau TC
        V = IIf(V = "", TC(I), V & TC(I)) 'revoie les chiffres triés dans la valeur V les uns après les autres
    Next I 'prochain chiffre de la boucle 3
    CEL.Value = CLng(V) 'renvoie dans la cellue CEL la valeur V convertie en données de type Long
    V = "" 'vide V
    Erase TC 'vide le tableau des chiffres TC
Next CEL 'prochaine cellule de la boucle
End Sub

Sub tri(a, gauc, droi) ' Quick sort tiré du site de Jacques BOISGONTIER : http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Bonjour à tous,

Merci pour votre rapidité et votre efficacité. J'ai pu adapter vos macros à mon fichier. Cela fonctionne parfaitement.

Merci encore, ce problème est résolu pour moi.

Cordialement.