TRI ALPHANUMERIQUE

[Fredo(67)]

Bonjour,

Dans une colonne j'ai des valeurs :
A-02
A-03
A-05
A-04
A-01
A-10
A-08
A-09
A-12
B-01
B-05
B-10
B-21
B-32
B-41


Je souhaiterai faire un tri à la fois par ordre alphabétique montant et descendant :
et avoir le résultat suivant :
A-12
A-10
A-09
A-08
A-05
A-04
A-03
A-02
A-01
B-41
B-32
B-21
B-10
B-05
B-01
d'abord tous les A, en descendant par rapport aux chiffres
puis tous les B, en descendant par rapport aux chiffres, et ainsi de suite

[MichD]

Le 14/12/21 à 10:32, Fredo(67) a écrit :

> A-02
> A-03
> A-05
> A-04
> A-01
> A-10
> A-08
> A-09
> A-12
> B-01
> B-05
> B-10
> B-21
> B-32
> B-41

Bonjour,

Dans les cellules, le contenu est alphanumérique. Par conséquent, le tri
en comparant caractère par caractère selon leur valeur ASCII. On ne peut
pas dire de faire autrement.

Je te suggère cette approche que tu peux exécuter sans macro.

A ) Sélectionne le données de la colonne
B ) Onglet Données / convertir
C ) Fenêtre I : Délimité
D ) Fenêtre II : Décoche toutes les cases sauf celle indiquant Autre et
tu inscris - (tiret) dans la case
E ) Fenêtre III : Indique la colonne B1 si tes données sont en A1 dans
la case Destination.
F ) Tu vas obtenir en B la liste des lettres et en colonne c, une liste
des données numériques.
G ) Sélectionne les 3 colonnes A, B, C et fais un tri croissant ou
décroissant sur la colonne C, tu vas obtenir ce que désires en colonne A.
H ) Tu supprimes les colonnes B et C.

MichD

[MichD]

Le 14/12/21 à 11:38, MichD a écrit :

OK, je n’avais pas lu, que tu voulusses aussi avoir les lettres par
ordre croissant ou décroissant en plus des chiffres. La proposition est
inexacte.

MichD

[MichD]

Le 14/12/21 à 11:43, MichD a écrit :

>> A-02
>> A-03
>> A-05
>> A-04
>> A-01
>> A-10
>> A-08
>> A-09
>> A-12
>> B-01
>> B-05
>> B-10
>> B-21
>> B-32
>> B-41

Après avoir fait, ce que j'ai proposé en lors de mon premier message,
après avoir sélectionné les 3 colonnes, tu appelles la commande Tri.
Tu dois utiliser 2 niveaux,
A ) D'abord sur la colonne B
B ) Tu ajoutes un autre niveau pour la colonne C

Pour chacun des niveaux, tu choisis l'ordre désiré pour le résultat
escompté.

MichD

[MichD]

Le 14/12/21 à 10:32, Fredo(67) a écrit :

> Bonjour,

N'oublie pas que tu peux copier-coller les données de cette colonne vers
une feuille de calcul vierge et exécuter la proposition et recopier les
données vers la plage originale.

MichD

[MichD]

Bonjour,

Tu peux automatiser la tâche comme ceci.

Adapte le nom de la feuille et de la plage de cellules.

'-------------------------------------------
Sub test()
Dim Rg As Range
Dim ShS As Worksheet
Dim Sh As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Set ShS = Worksheets("Feuil1") 'Nom feuille à adapter
With ShS
Set Rg = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
Set Sh = Worksheets.Add(after:=ActiveSheet)
Rg.Copy Sh.Range("A1")

Sh.Range("A1:A" & Rg.Rows.Count).TextToColumns
Destination:=Sh.Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True,
OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)),
TrailingMinusNumbers:=True

Sh.Sort.SortFields.Add2 Key:=Sh.Range("B1:B" & Rg.Rows.Count) _
, SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
Sh.Sort.SortFields.Add2 Key:=Sh.Range("C1:C" & Rg.Rows.Count) _
, SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal

With Sh.Sort
.SetRange Sh.Range("A1:C" & Rg.Rows.Count)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sh.Range("A1:A" & Rows.Count).Copy ShS.Range("A1")
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'-------------------------------------------

MichD

[MichD]

Voilà la même procédure, mais dans celle-ci tu n'as qu'à adapter le nom
de la feuille et la plage de cellule de départ sans inclure l'étiquette
de la colonne.

'------------------------------------------------------

Sub test()
Dim Rg As Range
Dim ShS As Worksheet
Dim Sh As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False

Set ShS = Worksheets("Feuil1") 'Nom feuille à adapter

With ShS

'Définis la plage de cellule (sans l'étiquette de colonne)
Set Rg = .Range("D5:D" & .Range("D" & .Rows.Count).End(xlUp).Row)

End With

Set Sh = Worksheets.Add(after:=ActiveSheet)

Rg.Copy Sh.Range(Rg.Cells(1, 1).Address)

Sh.Range(Rg.Address).TextToColumns Destination:=Sh.Range(Rg.Cells(1,
2).Address), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)),
TrailingMinusNumbers:=True

Sh.Sort.SortFields.Add2 Key:=Sh.Range(Rg.Columns(2).Address) _

, SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal

Sh.Sort.SortFields.Add2 Key:=Sh.Range(Rg.Columns(3).Address) _

, SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal

With Sh.Sort

.SetRange Sh.Range(Rg.Resize(, 3).Address)

.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sh.Range(Rg.Address).Copy Rg.Cells(1, 1)

Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

'------------------------------------------------------

MichD

[MichD]

Pour le plaisir, on peut simplifier l'exécution de la macro proposée. Il
n'y a qu'à définir les 3 variables au début de la procédure et exécuter
cette dernière.

'--------------------------------------------
Sub test()
Dim Rg As Range, LaFeuille As String
Dim ShS As Worksheet, Adr As String
Dim Sh As Worksheet, L As Long
Dim Ord As XlSortOrder

'*********VARIABLES À DÉFINIR*********
'le tri croisant ou décroissant
Ord = xlAscending 'ou xlDescending

'nom de l'onglet de la feuile où sont les données
LaFeuille = "Feuil1"

'Adresse de la première cellule de la colonne où débute les donnes.
Adr = "G24"
'*************************************

Application.ScreenUpdating = False
Application.EnableEvents = False

Set ShS = Worksheets(LaFeuille) 'Nom feuille à adapter

With ShS
L = .Cells(.Rows.Count, Range(Adr).Column).End(xlUp).Row
Set Rg = .Range(.Range(Adr), .Cells(L, Range(Adr).Column))

End With

Set Sh = Worksheets.Add(after:=ActiveSheet)
Rg.Copy Sh.Range(Rg.Cells(1, 1).Address)

Sh.Range(Rg.Address).TextToColumns Destination:=Sh.Range(Rg.Cells(1, 2) _
.Address), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _

Comma:=False, Space:=False, Other:=True, OtherChar _

:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), _

TrailingMinusNumbers:=True

Sh.Sort.SortFields.Add2 Key:=Sh.Range(Rg.Columns(2).Address) _

, SortOn:=xlSortOnValues, Order:=Ord, DataOption:=xlSortNormal
Sh.Sort.SortFields.Add2 Key:=Sh.Range(Rg.Columns(3).Address) _
, SortOn:=xlSortOnValues, Order:=Ord, DataOption:=xlSortNormal

With Sh.Sort
.SetRange Sh.Range(Rg.Resize(, 3).Address)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sh.Range(Rg.Address).Copy Rg.Cells(1, 1)
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'--------------------------------------------

MichD

[Fredo(67)]

Alors, il est vrai que je n'avais pas précisé, mais je ne peux pas rajouter de colonne.
Parceque j'ai réussi en faisant dans des colonnes adjacente des extractions, une fois de la valeur, une fois du chiffre et ensuite faire des tris.

Mais ce rajout me bloque dans la suite de la procédure à appliquer sur ces valeur une fois triées.

[MichD]

Le 16/12/21 à 10:37, Fredo(67) a écrit :

La procédure n'utilise pas les colonnes où sont tes données. Je crée une
nouvelle feuille, copie tes données sur cette feuille, effectue le
traitement désiré, et finalement j'écrase avec le résultat obtenu tes
données sources, après quoi, je supprime la feuille ajoutée.

MichD

[Fredo(67)]

Oui, j'ai aussi pensé à ce type de procédure.
Mais, parce qu'il y a un mais, je ne peux pas utiliser ce type d'astuce.
Il me faut, si c'est possible, faire ce tri "sur place" sans utiliser
- de colonnes supplémentaires
- de ligne supplémentaires
- d'autre feuille ou fichier...

J'imaginais que dans l'expression du caractère de tri il y aurait un moyen d'exprimer que
- les lettres soient classées en ordre alphabétique inverse
- Les chiffres en ordre numérique décroissant.

[MichD]

Le 14/12/21 à 10:32, Fredo(67) a écrit :

Mets cela dans un module standard.
Je n'ai testé qu'avec les données que tu as publiées

'----------------------------------------------------
Sub test()

Dim Rg As Range, C As Range, T()
Dim A As Long, Arr(), Elt As Variant
Dim B As Long, Compteur As Long
Dim G As Long, P As Long

'Tu peux placer toutes les lettres de l'alphabet
'si nécessaire en respectant la syntaxe
Arr = Array("A", "B")

With Worksheets("Feuil1") 'nom onglet feuille à adapter
Set Rg = Range("A1:A15") 'plage de cellules à adapter
End With

For Each Elt In Arr
For B = 1 + Compteur To Rg.Cells.Count
Select Case Left(Rg(B), 1)
Case Is = Elt
A = A + 1
ReDim Preserve T(1 To A)
T(A) = Val(Split(Rg(B), "-")(1))
Compteur = Compteur + 1
Case Else
B = Rg.Cells.Count
End Select
Next
Quick_Sort T, LBound(T), UBound(T)
A = 0
G = 1
Do While G <= UBound(T)
P = P + 1
A = A + 1
Rg(P, Rg.Column) = Elt & "-" & T(A)
G = G + 1
Loop
A = 0
B = 1
Next
End Sub
'----------------------------------------------------
Sub Quick_Sort(ByRef SortArray As Variant, ByVal First As Long, ByVal
Last As Long)
Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub
'----------------------------------------------------

MichD

[MichD]

Le 16/12/21 à 16:04, MichD a écrit :

Dans la procédure, il y a une erreur.
Remplace la ligne de code :

T(A) = Val(Split(Rg(B), "-")(1))

Par
T(A) = Cstr(Split(Rg(B), "-")(1))

Ça fait toute une différence!

MichD

[MichD]

Le fichier exemple ici :
https://www.cjoint.com/c/KLqwiT6fFUF

MichD

[Fredo(67)]

Merci, je vais étudier ça et adapter...

Passes de bonnes fêtes...

[Michel__D]

Une autre façon de faire avec (important) le type de données fourni :

Sub Trier_Valeur()
Dim oCol As Object
Dim oCell As Object
Dim iK As Long, iLig As Long, sVal As String
Set oCol = CreateObject("System.Collections.ArrayList")
For Each oCell In ThisWorkbook.ActiveSheet.Range("A:A")
If oCell.Value = "" Then Exit For
sVal = Chr(90 - Asc(Left(oCell.Value, 1)) + 65)
oCol.Add sVal & Mid(oCell.Value, 2)
Next oCell
oCol.Sort
iLig = 1
For iK = oCol.Count - 1 To 0 Step -1
sVal = Chr(90 - Asc(Left(oCol(iK), 1)) + 65)
ThisWorkbook.ActiveSheet.Cells(iLig, 1) = sVal & Mid(oCol(iK), 2)
iLig = iLig + 1
Next iK
Set oCell = Nothing
Set oCol = Nothing
End Sub

[MichD]

Bonjour Michel_D,

Tu devrais indiquer la bibliothèque (reference) qui permet d'exécuter
cette ligne de code dans Excel. Je n'ai jamais utilisé cela. Une
découverte pour moi.

Set oCol = CreateObject("System.Collections.ArrayList")

Il y a aussi ceci :

Fichier joint : https://www.cjoint.com/c/KLscoIC6wfE

La colonne n'a pas besoin d'être trié par ordre croissant des lettes du
début des chaînes de caractères.

Le code contenu du fichier :

Option Explicit
'---------------------------------------------------
Sub Tri()

Dim Rg As Range, C As Range

Dim T As String, S As Variant

'********Variables à définir*****************
'Nom de l'onglet de la feuille à définir
With Worksheets("Feuil1")
'plage de cellule à définir

Set Rg = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

'*********************************************

For Each C In Rg
T = T & C.Value & ","
Next
If Len(T) <> 0 Then
T = Left(T, Len(T) - 1)
End If
S = Split(TriSpecial(T, "-"), ",")
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Rg(1, 1).Resize(UBound(S) + 1) = Application.Transpose(S)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
'---------------------------------------------------
Function TriSpecial(S As String, Separator As String) As String
Dim X() As String
Dim tmp As String
Dim i As Long, j As Long

X = Split(S, ",")

For i = LBound(X) To UBound(X)
X(i) = Trim$(X(i))
Next

For i = LBound(X) To UBound(X) - 1
For j = LBound(X) To UBound(X) - 1
If X(j) > X(j + 1) Then
tmp = X(j + 1)
X(j + 1) = X(j)
X(j) = tmp
End If
Next
Next

tmp = ""
For i = LBound(X) To UBound(X)
tmp = tmp & X(i) & ","
Next
tmp = Left(tmp, Len(tmp) - 1)
TriSpecial = tmp
End Function
'---------------------------------------------------

MichD

[MichD]

Correction de cette petite coquille
code originale :
-------------------------

If Len(T) <> 0 Then
T = Left(T, Len(T) - 1)
End If

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

On devrait plutôt lire :
-------------------------

If Len(T) <> 0 Then
T = Left(T, Len(T) - 1)

Else
Exit sub
End If
-------------------------

MichD

[Michel__D]

Le 18/12/2021 à 03:34, MichD a écrit :
>
> Bonjour Michel_D,
>
> Tu devrais indiquer la bibliothèque (reference) qui permet d'exécuter cette
> ligne de code dans Excel. Je n'ai jamais utilisé cela. Une découverte pour moi.
>
> Set oCol = CreateObject("System.Collections.ArrayList")

La référence est : mscorlib.dll

https://docs.microsoft.com/fr-fr/dotnet/api/system.collections.arraylist?view=net-6.0

[MichD]

Le 19/12/21 à 06:59, Michel__D a écrit :

J'ai chargé la bibliothèque "mscorlib.dll", mais je n'ai pas réussi à
exécuter la macro.
Elle bloque toujours sur cette ligne de code :

Set oCol = CreateObject("System.Collections.ArrayList")

Le test a été fait à Microsoft Office 2016. Merci.

MichD

[Michel__D]

Sur quel OS ?

Je crois qu'il faut le .NET Framework 3.5

https://docs.microsoft.com/en-us/dotnet/framework/install/dotnet-35-windows

[MichD]

Le 20/12/21 à 13:00, Michel__D a écrit :

> Le 20/12/2021 à 00:28, MichD a écrit :
>>
>> Le 19/12/21 à 06:59, Michel__D a écrit :
>>> Le 18/12/2021 à 03:34, MichD a écrit :
>>>>
>>>> Bonjour Michel_D,
>>>>
>>>> Tu devrais indiquer la bibliothèque (reference) qui permet
>>>> d'exécuter cette ligne de code dans Excel. Je n'ai jamais utilisé
>>>> cela. Une découverte pour moi.
>>>>
>>>> Set oCol = CreateObject("System.Collections.ArrayList")
>>>
>>> La référence est : mscorlib.dll
>>>
>>> https://docs.microsoft.com/fr-fr/dotnet/api/system.collections.arraylist?view=net-6.0
>>>
>> J'ai chargé la bibliothèque "mscorlib.dll", mais je n'ai pas réussi à
>> exécuter la macro.
>> Elle bloque toujours sur cette ligne de code :
>> Set oCol = CreateObject("System.Collections.ArrayList")
>>
>> Le test a été fait à Microsoft Office 2016. Merci.
>>
>> MichD
>
> Sur quel OS ?

Windows 10


> https://docs.microsoft.com/en-us/dotnet/framework/install/dotnet-35-windows

OK. Merci.

MichD