Problême de tri

[JACRAV]

Bonjour à tous

J'ai un problême de tri dans un fichier!
J'ai 5 références comme ci-dessous dans une colonne:

DAU1015
DAU1018
DAU1522
DAU69
DAU812
Je souhaiterais lorsque je fais un tri que les références(ce sont des dimensions)
S'affichent comme suit:
DAU69
DAU812
DAU1015
DAU1018
DAU1522
j'ai beau chercher mais je n'y arrive pas.Je reviens toujours à la case départ!

plage.Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Pouvez-vous m'aider?
Merci par avance.
Bon We
Bien cordialement
Jacques

 

[MJ13]

Re : Problême de tri

Boinjour Jacrv

Essaye avec les tris personnalisés, mais à mon avis, cela va par le faire car je pense que tu n'as pas que ces références à trier 😕

 

[pierrejean]

Re : Problême de tri

Bonjour JACRAV

SAlut Michel

Un essai Vba (trie selon le Nombre en ignorant la partie alphabetique)

 

[ROGER2327]

Re : Problême de tri

Bonjour à tous

En l’absence regrettable d'un support, un essai à adapter.​

ROGER2327
#5199

Mercredi 11 Clinamen 138 (Saint Maquereau, Intercesseur, SQ)
13 Germinal An CCXIX
2011-W13-6T14:19:40Z

 

[david84]

Re : Problême de tri

Bonsoir à tous,
essai d'une proposition prenant en compte les lettres et les nombres mais à tester plus avant (système de pondération tenté peut avoir besoin d'être réglé plus finement). On doit cependant pouvoir faire plus simple...

Sub testTri()
Dim tabl, i&, j&, k&, l&, m&, n&, Résultat&, temp, DerLigne&
DerLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("F1:F" & DerLigne).ClearContents
tabl = Range("A1:A" & DerLigne).Value
Dim tabl2()
ReDim tabl2(1 To DerLigne)
    For i = 1 To DerLigne
        For j = 1 To Len(Cells(i, 1))
            Résultat = Résultat + Asc(Mid(Cells(i, 1), j, 1)) * _
            ((Len(Cells(i, 1)) - j + Asc(Mid(Cells(i, 1), j, 1)) / 10))
       Next j
       tabl2(i) = tabl(i, 1) & "#" & Résultat
       Résultat = 0
    Next i
Dim tabl3
ReDim tabl3(1 To DerLigne)
    For k = 1 To DerLigne
    tabl3(k) = CDbl(Right(tabl2(k), Len(tabl2(k)) - InStr(1, tabl2(k), "#")))
    Next k
Dim tabl4
ReDim tabl4(1 To DerLigne)
    For l = 1 To DerLigne
    tabl4(l) = Application.WorksheetFunction.Small(tabl3, l)
    Next l
Dim tabl5
ReDim tabl5(1 To DerLigne)
    For m = 1 To DerLigne
        For n = 1 To DerLigne
            If tabl4(m) = CDbl(Right(tabl2(n), _
            Len(tabl2(n)) - InStr(1, tabl2(n), "#"))) Then tabl5(m) = tabl(n, 1)
        Next n
    Next m
 Range("F1").Resize(UBound(tabl5)) = Application.Transpose(tabl5)
End Sub

A+

 

[david84]

Re : Problême de tri

Re
ci-joint nouveau code modifié :
- procédure de pondération retouché (mais peut-être encore à affiner),
- les références rentrées en minuscules sont traitées et retranscrites en majuscules.
Après, faute de fichier, difficile de cerner exactement l'attente initiale.

Sub testTri()
Dim tabl, i&, j&, k&, l&, m&, n&, Résultat&, temp, DerLigne&
DerLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("F1:F" & DerLigne).ClearContents
tabl = Range("A1:A" & DerLigne).Value
Dim tabl2()
ReDim tabl2(1 To DerLigne)
    For i = 1 To DerLigne
        For j = 1 To Len(Cells(i, 1))
            Résultat = Résultat + Asc(Mid(UCase(Cells(i, 1)), j, 1)) * 2 ^ ((Len(Cells(i, 1)) - j))
       Next j
       tabl2(i) = tabl(i, 1) & "#" & Résultat
       Résultat = 0
    Next i
Dim tabl3
ReDim tabl3(1 To DerLigne)
    For k = 1 To DerLigne
    tabl3(k) = CDbl(Right(tabl2(k), Len(tabl2(k)) - InStr(1, tabl2(k), "#")))
    Next k
Dim tabl4
ReDim tabl4(1 To DerLigne)
    For l = 1 To DerLigne
    tabl4(l) = Application.WorksheetFunction.Small(tabl3, l)
    Next l
Dim tabl5
ReDim tabl5(1 To DerLigne)
    For m = 1 To DerLigne
        For n = 1 To DerLigne
            If tabl4(m) = CDbl(Right(tabl2(n), _
            Len(tabl2(n)) - InStr(1, tabl2(n), "#"))) Then tabl5(m) = UCase(tabl(n, 1))
        Next n
    Next m
 Range("F1").Resize(UBound(tabl5)) = Application.Transpose(tabl5)
End Sub

A+

 

[JACRAV]

Re : Problême de tri

Bonsoir
A chacun qui a eu la gentillesse de m'aider,un grand merci;
Avec les éléments fournis je pense pouvoir résoudre mon problême.

Avec toute ma gratitude
Bien cordialement
jacques