Classement de chiffres AVEC lettres

Bonjour,

Je viens vers vous car je n'arrive pas à classer une liste de référence par ordre alphanumérique. Je m'explique :

J'ai une liste de référence (CA0001, CA1, CA102, CAA2, etc) et j'aimerai la classer comme suit :

CA0001 ---> CA0014 ensuite CA1 ---> CA480T et CAA1 ---> CARBG250

J'ai essayé en faisant un premier tri de A à Z et ensuite par une formule =DROITE(B2;3) pour pouvoir effectuer un second filtre de A à Z mais il y a des incohérences.

C'est une liste non exhaustive, elle est amenée à évoluer et grandir.

Merci d'avance,

Salut Antoine,

quelque chose doit m'échapper car je vois que c'est classé comme tu le décris...

Mais encore?

A+

Bonjour Curulis,

En partie, oui, ça marche.

Mais pas totalement. Regarde les lignes 37 à 39. Le CA87/120 devrait être classé plus haut (Au dessus du CA100) avec derrière lui le CA87/140, 160, 180, etc)

Autre exemple : lignes 125 à 136, les références CA32/1, etc devrait être au-dessus du CA87. Pareil pour CA30A (Ligne 176), etc.

Ouais, je comprends...

Brain is turbining...

Non, je n'ai rien dit...

bonjour,

une solution via une macro, attention ne trie que la colonne B !

Sub aargh()
    dl = Cells(Rows.Count, 2).End(xlUp).Row
    Range("C:F").Insert shift:=xlToRight
    'creation des clés de tri
    For i = 2 To dl
        a = Cells(i, 2)
        t = ""
        k = 1
        For j = 1 To Len(a)
            b = Mid(a, j, 1)
            Select Case k
            Case 1
                If b Like "[0-9]" Then Cells(i, k + 2) = t: t = IIf(b = 0, "0.", ""): k = k + 1
            Case 2
                If Not b Like "[0-9]" Then Cells(i, k + 2) = t: t = "": k = k + 1
            Case 3
                If b Like "[0-9]" Then Cells(i, k + 2) = t: t = "": k = k + 1
            End Select
            t = t + b
        Next j
        Cells(i, k + 2) = t
        For j = 3 To 6
            If Cells(i, j) = "" Then Cells(i, j) = "."
        Next j
    Next i
    'tri
    With ActiveWorkbook.ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("C2:C" & dl) _
                             , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("D2:D" & dl) _
                             , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("E2:E" & dl) _
                             , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("F2:F" & dl) _
                             , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("B2:F" & dl) ' pour trier un tableau plus large remplacer F par la dernière colonne du tableau à trier +4 colonnes
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'suppression des clés de tri
    Columns("C:F").Delete shift:=xlToLeft
End Sub

lancer la macro via alt-F8

Salut Antoine, H2SO4,

quelque chose comme ça? 8)

Un double-clic pour démarrer la macro, le résultat du tri s'affichant après 2 petites secondes en [F:F].

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tSort() As String
Cancel = True
'
iRow = Range("B" & Rows.Count).End(xlUp).Row
tData = Range("B2:B" & iRow).Value
iIdx = 1
'
For x = 1 To UBound(tData, 1)
    sData = CStr(tData(x, 1))
    iFlag = -1
    iIdx = iIdx + 1
    iTypeOUT = 0
    ReDim Preserve tSort(5, iIdx)
    For y = 1 To Len(sData)
        For Z = 1 To 3
            If Asc(Mid(sData, y, 1)) > Choose(Z, 64, 47, 46) Then
                iTypeIN = Z
                Exit For
            End If
        Next
        If iTypeOUT <> iTypeIN Then
            iTypeOUT = iTypeIN
            iFlag = iFlag + 1
        End If
        tSort(iFlag, iIdx - 2) = tSort(iFlag, iIdx - 2) & Mid(sData, y, 1)
    Next
Next
For x = 4 To 0 Step -1
    For y = 0 To iIdx - 2
        For Z = 1 To iIdx - 2
            If (IsNumeric(Left(tSort(x, Z), 1)) And Left(tSort(x, Z), 1) > 0) And _
                        (IsNumeric(Left(tSort(x, Z - 1), 1)) And Left(tSort(x, Z - 1), 1) > 0) Then
                If CInt(tSort(x, Z - 1)) > CInt(tSort(x, Z)) Then
                    For k = 0 To 4
                        tSort(k, UBound(tSort, 2)) = tSort(k, Z)
                        tSort(k, Z) = tSort(k, Z - 1)
                        tSort(k, Z - 1) = tSort(k, UBound(tSort, 2))
                    Next
                End If
            Else
                If CStr(tSort(x, Z - 1)) > CStr(tSort(x, Z)) Then
                    For k = 0 To 4
                        tSort(k, UBound(tSort, 2)) = tSort(k, Z)
                        tSort(k, Z) = tSort(k, Z - 1)
                        tSort(k, Z - 1) = tSort(k, UBound(tSort, 2))
                    Next
                End If
            End If
        Next
    Next
Next
For x = 1 To UBound(tData, 1)
    sData = ""
    For y = 0 To 4
        sData = sData & tSort(y, x - 1)
    Next
    tData(x, 1) = sData
Next
Range("F2").Resize(UBound(tData, 1), 1) = tData
'
End Sub

A+