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,
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
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
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.