Trier suivant 2 colonnes Dans un Tableau

Bonjour Le Forum,

J'ai cherché sur internet mais je n'ais pas trouvé ce dont je souhaite.

Je suis passé par deux fois la fonction "Trier de A à Z" avec "Étendre la sélection".

La première fois sur la colonne C (Sexe) et la deuxième fois sur la colonne D (Mesure)

Ceci me permet de grouper les sexe F dissocié des sexe M malgré qu'il ai la même mesure.

Ça donne à peut prêt ce dont je souhaite mais le tri de la colonne D ne prend pas l'ordre correctement..

Un membre du forum a proposé ce code pour trier une colonne:

Public Sub Sort_Data()
Dim tbl, i As Long, j As Long, a, b, tmp
    tbl = ActiveSheet.Cells(2, 4).Resize(7).Value
    For i = 1 To UBound(tbl)
        For j = i To UBound(tbl)
            a = Val(Split(tbl(i, 1), " ")(0))
            b = Val(Split(tbl(j, 1), " ")(0))
            If b < a Then
                tmp = tbl(j, 1)
                tbl(j, 1) = tbl(i, 1)
                tbl(i, 1) = tmp
            End If
        Next j
    Next i
    ActiveSheet.Cells(2, 4).Resize(7).Value = tbl
End Sub

Bonjour,

J'ai tout de même une question:

Si toutes les mesures sont en mm. et les poids en kg., pourquoi ne pas saisir un nombre ?

Cdlt.

C'est extrait d'un logiciel du coup c'est écris comme ça...

Bonsoir Sebyg, Jean-Eric

En colonne F via une formule, tu extrais le nombre présent en colonne D

Puis dans le tableur, tu effectues un tri successif sur la colonne C et F tout simplement

Tu te compliques vraiment la vie

Sub tri()
    With Sheets("Feuil1")
        Application.ScreenUpdating = False
        With .Range("A1").CurrentRegion
            With .Offset(1, .Columns.Count).Resize(.Rows.Count - 1, 1)
                .Formula = "=LEFT(D2,FIND(""."",D2)-1)"
                .Value = .Value
            End With
            .CurrentRegion.Sort key1:=.Cells(1, 3), order1:=xlAscending, _
            key2:=.Cells(1, 6), order2:=xlAscending, Header:=xlYes
        End With
    End With
End Sub

klin89

Re Sebyg,

Après tu peux trier la variable tableau via une procédure de tri que tu trouveras sur le site de Jacques Boisgontier

Sub test()
    With Sheets("Feuil1").Range("A1").CurrentRegion
        a = .Resize(, 6).Value
        For i = 2 To UBound(a, 1)
            a(i, 6) = CLng(Evaluate("=LEFT(""" & a(i, 4) & """,FIND(""."",""" & a(i, 4) & """)-1)"))
        Next
        With .Offset(, .Columns.Count + 1)
            .Resize(UBound(a, 1), UBound(a, 2)).Value = a
        End With
    End With
End Sub

kiln89

Bonjour Klin89,

Klin89 a écrit :

Tu te compliques vraiment la vie

Je t'avoue que je suis débutant en VBA, du coup c'est à peut prêt ça que je souhaitait mais ça tri les F ensemble et les M puis sa classe les mesures. Est-il possible que ça mettent les Mesures ensemble plutôt ?

J'essai de comprendre le code:

Sub tri()
    With Sheets("Feuil1") 'Sur la Feuil1
        Application.ScreenUpdating = False
        With .Range("A1").CurrentRegion 'Défini la zone tableau via A1
            With .Offset(1, .Columns.Count).Resize(.Rows.Count - 1, 1) 'là je comprend pas tout :/
                .Formula = "=LEFT(D2,FIND(""."",D2)-1)" 'Ceci permet de garder que la mesure sans les mm
                .Value = .Value
            End With
            .CurrentRegion.Sort key1:=.Cells(1, 3), order1:=xlAscending, _  'là je suis perdu  :-))) 
            key2:=.Cells(1, 6), order2:=xlAscending, Header:=xlYes
        End With
    End With
End Sub

EDIT:

En faite j'ai réussit a comprendre...

Sub tri()
    With Sheets("Feuil1") 
        Application.ScreenUpdating = False
        With .Range("A1").CurrentRegion 'Défini la zone tableau via A1
            With .Offset(1, .Columns.Count).Resize(.Rows.Count - 1, 1) 'là je comprend pas tout :/
                .Formula = "=LEFT(D2,FIND(""."",D2)-1)" 'Ceci permet de garder que la mesure sans les mm
                .Value = .Value
            End With
            'Défini la colonne à trier
            .CurrentRegion.Sort key1:=.Cells(1, 6), order1:=xlAscending, _
            key2:=.Cells(1, 6), order2:=xlAscending, Header:=xlYes
        End With
    End With
End Sub

J'ai un petit soucis, je n'ai plus d'entête je souhaite traiter dès la ligne 1.

Et du coup ça ne fonctionne plus..

Re Sebyg,

Voici le tri via la variable tableau directement

J'ai récupéré la procédure de tri sur le site de Jacques Boisgontier

Option Explicit
Option Compare Text
Sub test()
Dim a(), i As Long
    With Sheets("Feuil1").Range("A1").CurrentRegion
        a = .Resize(, 6).Value
        For i = 2 To UBound(a, 1)
            a(i, 6) = CLng(Evaluate("=LEFT(""" & a(i, 4) & """,FIND(""."",""" & a(i, 4) & """)-1)"))
        Next
        Call Tri(a(), LBound(a, 1) + 1, UBound(a, 1))
        With .Offset(, .Columns.Count + 1)
            .Resize(UBound(a, 1), UBound(a, 2) - 1).Value = a
        End With
    End With
End Sub

Sub Tri(a(), gauc, droi)  ' Quick sort
Dim ref As String, g As Long, d As Long, k As Byte, temp
    ref = a((gauc + droi) \ 2, 3) & Format(a((gauc + droi) \ 2, 6), "0000")
    g = gauc: d = droi
    Do
        Do While a(g, 3) & Format(a(g, 6), "0000") < ref: g = g + 1: Loop
        Do While ref < a(d, 3) & Format(a(d, 6), "0000"): d = d - 1: Loop
        If g <= d Then
            For k = LBound(a, 2) To UBound(a, 2)
                temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
            Next k
            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

Edit : je n'ai pas pu ouvrir ton dernier fichier joint via le convertisseur, je suis sous Excel2003 chez moi

klin89

Bonjour Klin89,

Je suis désolé mais je ne comprend rien..

J'ai essayé, mais ça décale tout ..

J'espère que cette fois ça va fonctionner mon excel ci-joint.

Avec un exemple je comprendrais certainement mieux je ne sais pas..

Bonjour,

2 nouvelles questions :

1 - Les unités sont-elles toujours des mm. et de kg. ?

2 - As-tu d'éventuels calculs à faire avec ces données ?

Cdlt.

Bonjour !

1 - Oui les unités sont toujours les même mm et Kg

2 - Non je n'ai aucun calcul à faire. Juste a les tiers les mettres dans l'ordre et avoir une belle présentation à chaque fois.

Par contre encore après, il y a des colonnes que je souhaiterai fusionner..

Re,

Une nouvelle proposition à étudier.

Cdlt.

Public Sub Sort_Data()
Dim ws As Worksheet, rng As Range
    Set ws = ActiveSheet
    With ws
        Set rng = .Cells(1).CurrentRegion
        .Cells(4).Value = "Mesure (mm)"
        .Cells(5).Value = "Poids (kg)"
        .Cells(2, 4).Resize(rng.Rows.Count - 1).Replace " mm", ""
        .Cells(2, 5).Resize(rng.Rows.Count - 1).Replace "kg", ""
        With .Sort
            .SortFields.Add rng.Cells(4), xlSortOnValues, xlAscending
            .SortFields.Add rng.Cells(3), xlSortOnValues, xlAscending
            .SetRange rng
            .Header = xlYes
            .Apply
            .SortFields.Clear
        End With
    End With
End Sub

Re,

Oui ça ce serrai top, encore faut-il que je l'adapte correctement n'ayant plus la première ligne. (Mesure et Poids)

Du coup j'ai essayé ce code:

Public Sub Sort_Data()
Dim ws As Worksheet, rng As Range
    Set ws = ActiveSheet
    With ws
        Set rng = .Cells(1).CurrentRegion
        .Cells(1, 4).Resize(rng.Rows.Count - 1).Replace " mm", ""
        .Cells(1, 5).Resize(rng.Rows.Count - 1).Replace "kg", ""
        With .Sort
            .SortFields.Add rng.Cells(4), xlSortOnValues, xlAscending
            .SortFields.Add rng.Cells(3), xlSortOnValues, xlAscending
            .SetRange rng
            .Header = xlYes
            .Apply
            .SortFields.Clear
        End With
    End With
End Sub

Mais ça marche pas.. ^^

Bonjour,

Je crois qu'il manque une correction :

.Header = xlYes
'Devient :
.Header = xlNo

Ma ligne 7 n'est pas prise en compte dans le tableau..

Re,

Une nouvelle proposition.

Si cela ne correspond pas au résultat souhaité, redéfinis les champs à trier et l'ordre de tri.

Cdlt.

Public Sub Sort_Data()
Dim ws As Worksheet, rng As Range
    Set ws = ActiveSheet
    With ws
        Set rng = .Cells(1).CurrentRegion
        .Cells(6).Resize(rng.Rows.Count).Replace " mm", ""
        .Cells(7).Resize(rng.Rows.Count).Replace "kg", ""
        With .Sort
            '1 : sexe ; 2 - mesure
            .SortFields.Add rng.Cells(5), xlSortOnValues, xlAscending
            .SortFields.Add rng.Cells(6), xlSortOnValues, xlAscending
            .SetRange rng
            .Header = xlNo
            .Apply
            .SortFields.Clear
        End With
    End With
End Sub

Bonjour à tous,

Ben oui que ça marche pas , tu as enlevé la ligne d'en-têtes et rajouter des colonnes

Le code réajusté :

Je te laisse modifier le code dont le tri s'effectue via le tableur, voir la remarque de Pedro22

Option Explicit
Option Compare Text
Sub test()
Dim a(), i As Long
    With Sheets("Feuil1").Range("A1").CurrentRegion
        a = .Resize(, 8).Value
        For i = 1 To UBound(a, 1)
            a(i, 8) = CLng(Evaluate("=LEFT(""" & a(i, 6) & """,FIND(""."",""" & a(i, 6) & """)-1)"))
        Next
        Call Tri(a(), LBound(a, 1), UBound(a, 1))
        With .Offset(, .Columns.Count + 1)
            .Resize(UBound(a, 1), UBound(a, 2) - 1).Value = a
        End With
    End With
End Sub

Sub Tri(a(), gauc, droi)  ' Quick sort
Dim ref As String, g As Long, d As Long, k As Byte, temp
    ref = a((gauc + droi) \ 2, 5) & Format(a((gauc + droi) \ 2, 8), "0000")
    g = gauc: d = droi
    Do
        Do While a(g, 5) & Format(a(g, 8), "0000") < ref: g = g + 1: Loop
        Do While ref < a(d, 5) & Format(a(d, 8), "0000"): d = d - 1: Loop
        If g <= d Then
            For k = LBound(a, 2) To UBound(a, 2)
                temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
            Next k
            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

Pas certain que tu vois toutes les modifications apportées

klin89

Après quelques minutes voir peut être heures passées j'ai réussi avec le code de Jean-Eric.

Le tiens Klin89 j'ai passé beaucoup de temps mais je n'arrivais pas à comprendre les lignes pour les adapter.

Le principale c'est que j'ai compris le code et que ça fonctionne désormais !!

En tout cas je vous remercie d'avoir pris de votre temps pour répondre à ce soucis.

Re,

Merci de ce retour.

A la prochaine question.

Et bonnes fêtes de fin d'années, avec un peu d'avance.

Cdlt.