Tri multicolonne sur tableau VBA

david84

XLDnaute Barbatruc
Bonjour,
Je cherche à obtenir un tri dans un tableau comportant plusieurs colonnes.
Sur Excel 2007, il est possible d'obtenir cela via Donnée=>trier et en triant par niveau dans la boîte de dialogue "Tri".
Je cherche à obtenir le même résultat mais en utilisant des arrays.
Je pensais y être arrivé en procédant comme suit :
- charger le tableau de la feuille de calcul dans un array
- regrouper les différentes données d'une ligne au sein d'une même chaîne
- utiliser un quick sort emprunté à JB
- utiliser un split pour re dispatcher les différentes données triées dans la feuille de calcul.

La procédure en elle-même fonctionne sauf que je bute sur un problème : la colonne 2 comporte des âges. tant que ceux-ci sont inférieurs à 100, le tri est effectué correctement. Si l'âge est égale ou supérieur à 100 : problème.
J'en conclus donc que la chaîne est traitée comme une chaîne de caractère et que 100 n'est pas traité comme nombre mais comme 1 0 0.
J'ai testé éventuellement un option compare ainsi que le fait d'utiliser Cdbl si la valeur est numérique, mais sans résultat.
Avant éventuellement d'envisager d'autres approches, je voudrais savoir si vous aviez une solution pour résoudre ce problème.
Le tableau exemple est tiré d'un fichier produit par Misange que vous pouvez trouver Ce lien n'existe plus et que je vous recommande.
Code:
Option Explicit
'Option Compare Text
'Option Compare Binary
Sub TriMultiColonne()
Dim tblo, Pl, i, j, temp
Set Pl = Sheets("Feuil1").Range("A2").CurrentRegion.Offset(1) _
.Resize(Sheets("Feuil1").Range("A2").CurrentRegion.Rows.Count - 1)
tblo = Pl.Value
Dim tblo2()
ReDim Preserve tblo2(1 To Pl.Rows.Count)
For i = 1 To Pl.Rows.Count
    For j = 1 To Pl.Columns.Count
    'If IsNumeric(tblo(i, j)) Then
    '    tblo2(i) = tblo2(i) & CDbl(tblo(i, j)) & ""
    'Else
    tblo2(i) = tblo2(i) & tblo(i, j) & "#"
    'End If
    Next j
Next i
temp = tblo2
Call tri(temp, LBound(temp), UBound(temp))
Dim tblo3()
ReDim Preserve tblo3(1 To Pl.Rows.Count)
For i = 1 To Pl.Rows.Count
    For j = 1 To Pl.Columns.Count
        tblo3(i) = Split(temp(i), "#")
    Next j
Next i
Sheets("Feuil1").Range("H2").Resize(Pl.Rows.Count, Pl.Columns.Count) = _
Application.Transpose(Application.Transpose(tblo3))
End Sub
Sub tri(a, gauc, droi) ' Quick sort
Dim g, d, ref, temp
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      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
A+
 

Pièces jointes

  • TriMultiColonne.xls
    49 KB · Affichages: 258
  • TriMultiColonne.xls
    49 KB · Affichages: 279
  • TriMultiColonne.xls
    49 KB · Affichages: 257

Dranreb

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonjour
Non avec ce que vous avez commencé puis mis en commentaire, le 'If IsNumeric(tblo(i, j)) Then
' tblo2(i) = tblo2(i) & ... ça peut marcher, mais au lieu de continuer par CDbl(tblo(i, j)) c'est au contraire Format(tblo(i, j),"000") qu'il faut mettre

P.S. Sinon j'ai un module de classe qui pourrait ordonner vos lignes sans avoir à faire de concaténation si ça vous intéresse, il ne resterait qu'à faire les comparaisons demandées par ce module.
À +
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonjour David :), Bernard :)

Pour trier le tableau sur la colonne A puis sur la colonne B :

Code:
Sub TriMultiColonne()
Dim tablo, ub&, i&, t1$, t2 As Byte, t3$
tablo = Range("A2:C" & [A65536].End(xlUp).Row)
ub = UBound(tablo)
1 For i = 1 To ub - 1
  If tablo(i, 1) > tablo(i + 1, 1) Or _
    tablo(i, 1) = tablo(i + 1, 1) And tablo(i, 2) > tablo(i + 1, 2) Then
    t1 = tablo(i, 1): t2 = tablo(i, 2): t3 = tablo(i, 3)
    tablo(i, 1) = tablo(i + 1, 1): tablo(i, 2) = tablo(i + 1, 2): tablo(i, 3) = tablo(i + 1, 3)
    tablo(i + 1, 1) = t1: tablo(i + 1, 2) = t2: tablo(i + 1, 3) = t3
   GoTo 1
  End If
Next
[A2].Resize(ub, 3) = tablo
End Sub
Fichier joint.

A+
 

Pièces jointes

  • TriMultiColonne(1).xls
    52 KB · Affichages: 189

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Tri multicolonne sur tableau VBA

Bonjour,

Voir exemples en PJ

Code:
 '
 'Dupont   xxx xxx 3000
 'Balu     xxx xxx 3200
 'Toto     xxx xxx 3400
 'Balu     xxx xxx  999
 'Carvallo xxx xxx 3600
 '

Code:
Sub TriTableau2D()
 Dim a()
 a = [A2:D7].Value        ' Tableau 2D
 Call Tri(a(), LBound(a, 1), UBound(a, 1))
 [F2].Resize(UBound(a, 1), UBound(a, 2)) = a
End Sub

Sub Tri(a(), gauc, droi)  ' Quick sort
   ref = a((gauc + droi) \ 2, 1) & Format(a((gauc + droi) \ 2, 4), "0000")
   g = gauc: d = droi
   Do
      Do While a(g, 1) & Format(a(g, 4), "0000") < ref: g = g + 1: Loop
      Do While ref < a(d, 1) & Format(a(d, 4), "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

Avec un module de classe

http://boisgontierjacques.free.fr/fichiers/Cellules/ClasseTableau.xls

Il suffit d'écrire:

Code:
Set monTab = New Tableau    
monTab.TriTabMult Tablo, 4, 1   ' Tri multi crit col 4, col 1


JB
 

Pièces jointes

  • TriTableau2DIndex.xls
    32 KB · Affichages: 152
  • TriTableau2D2Crit.xls
    30 KB · Affichages: 137
Dernière édition:

job75

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re,

Pour généraliser avec un tableau dont le nombre de colonnes est quelconque :

Code:
Sub TriMultiColonne()
Dim tablo, ub1&, ub2 As Byte, i&, j As Byte, t As Variant
tablo = [A1].CurrentRegion
ub1 = UBound(tablo)
ub2 = UBound(tablo, 2)
1 For i = 2 To ub1 - 1
  If tablo(i, 1) > tablo(i + 1, 1) Or _
    tablo(i, 1) = tablo(i + 1, 1) And tablo(i, 2) > tablo(i + 1, 2) Then
    For j = 1 To ub2
      t = tablo(i, j)
      tablo(i, j) = tablo(i + 1, j)
      tablo(i + 1, j) = t
    Next
   GoTo 1
  End If
Next
[A1].Resize(ub1, ub2) = tablo
End Sub
Fichier (2).

A+
 

Pièces jointes

  • TriMultiColonne(2).xls
    52 KB · Affichages: 173

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re
Merci à Job et Bernard pour vos réponses.
@Bernard : j'ai testé avec forlat et/ou CDbl mais cela donne rien de mon côté.
Un Debug.Print effectué après le test me ramène toujours un String.
Concernant le module de classe proposé, pourquoi pas bien sûr.

@Job : ta solution fonctionne a priori très bien. Ceci dit, je vais bien la tester sur un nombre de colonnes plus important pour m'en assurer et tenter de la comprendre, et te faire un retour plus précis.
Je vois cependant que tu as utilisé un tri à bulle alors que je tentais de privilégier le quick sort bien plus rapide sur de grandes plages (mais peut-être que le quick sort n'est pas la meilleur solution en l'état...à voir).

@autres : si vous avez une solution à mon problème initial ou d'autres solutions à proposer, n'hésitez pas.
A+

Edit :
@Job : Merci pour ton autre message. Je ferai donc mes tests sur ta nouvelle proposition.
@Bernard : merci pour ton fichier. Je regarderai cela.
@Jacques : merci pour ta proposition. J'étudie cela (dès que j'aurai un moment ce WE) et te fais un retour mais je remarque déjà que tu es passé par un quick sort.
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re,

Je ne savais pas que la méthode de tri que j'ai utilisée s'appelait "tri à bulle".

Effectivement ça prend un temps fou :

- copié 10 fois le tableau => 350 lignes => 10 s sur Excel 2003

- copié 100 fois => 3500 lignes => pas eu la patience d'attendre la fin...

Sans se casser la tête, rien ne vaut un bon vieux tri sur feuille Excel :p

Code:
Sub TriMultiColonne()
Dim W As Worksheet
Application.ScreenUpdating = False
Set W = ActiveSheet
W.[A1].CurrentRegion.Copy Workbooks.Add.Sheets(1).[A1]
With ActiveSheet.[A1].CurrentRegion
  .Sort .Columns(1), , .Columns(2), Header:=xlYes
  .Copy W.[A1]
End With
ActiveWorkbook.Close False
End Sub
Fichier (3).

Mais ce n'est pas "la classe".

Edit : j'utilise un document auxiliaire uniquement pour le cas où l'on veut utiliser le tableau trié à d'autres fins...

A+
 

Pièces jointes

  • TriMultiColonne(3).xls
    52 KB · Affichages: 116
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

350 lignes => 10 s sur Excel 2003
Le temps consacré à l'indexation par mon module de classe est de 3,7 ms pour 350 élément.
Pour 3500 élément il est de 63,5 ms. Ces temps soit à multiplier par le rapport du temps pris par une comparaison (effectuée par le module appelant) sur celui d'une comparaison de 2 entiers Long en table.
Cordialement.
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Tri multicolonne sur tableau VBA

Tri d'un tableau 2D

Voir PJ

0,07sec pour 5.000 lignes

Code:
Sub TriTableau2D()
 t = Timer()
 Dim clé() As String, index() As Long
 a = [A2:C5101].Value
 Dim b()
 ReDim b(LBound(a) To UBound(a), LBound(a, 2) To UBound(a, 2))
 ReDim clé(1 To UBound(a, 1))
 ReDim index(1 To UBound(a, 1))
 For i = 1 To UBound(a, 1)
   clé(i) = a(i, 1) & Format(a(i, 3), "0000"): index(i) = i
 Next i
 Call Tri(clé(), index(), 1, UBound(clé))
 For lig = 1 To UBound(clé)
   For col = 1 To UBound(a, 2): b(lig, col) = a(index(lig), col): Next col
 Next lig
 [G2].Resize(UBound(b), UBound(b, 2)) = b    'Attention! pas de dates dans le champ
 MsgBox Timer() - t
End Sub

Sub Tri(clé() As String, index() As Long, gauc, droi) ' Quick sort
   ref = clé((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While clé(g) < ref: g = g + 1: Loop
      Do While ref < clé(d): d = d - 1: Loop
        If g <= d Then
           temp = clé(g): clé(g) = clé(d): clé(d) = temp
           temp = index(g): index(g) = index(d): index(d) = temp
           g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call Tri(clé, index, g, droi)
    If gauc < d Then Call Tri(clé, index, gauc, d)
End Sub

0,15 s pour 5.000 lignes

Code:
Sub TriTableau2D()
 Dim a()
 a = [A2:D5001].Value        ' Tableau 2D
 t = Timer()
 Call Tri(a(), LBound(a, 1), UBound(a, 1))
 [F2].Resize(UBound(a, 1), UBound(a, 2)) = a    ' Attention! pas de dates dans le champ
 MsgBox Timer() - t
End Sub

Sub Tri(a(), gauc, droi)  ' Quick sort
   ref = a((gauc + droi) \ 2, 1) & Format(a((gauc + droi) \ 2, 3), "0000")
   g = gauc: d = droi
   Do
      Do While a(g, 1) & Format(a(g, 3), "0000") < ref: g = g + 1: Loop
      Do While ref < a(d, 1) & Format(a(d, 3), "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

@JOB http://boisgontierjacques.free.fr/fichiers/Tri/CompareTri.xls

PS: Le but n'est pas de concurrencer le tri du tableur Excel mais d'effectuer des tris de tableaux (Array) sans passer par le tableur.

Avec un module de classe Tableau

http://boisgontierjacques.free.fr/fichiers/Cellules/ClasseTableau.xls

Code:
Sub Tris()
  Tablo = [a2:D6].Value
  Set monTab = New Tableau        ' instanciation de la classe Tableau
  monTab.TriTabMult Tablo, 4, 1    ' Tri multi crit col 4, col 1
End Sub



JB
 

Pièces jointes

  • TriTableau2DIndex2Crit.zip
    231.5 KB · Affichages: 124
  • TriTableau2D2CritEssai.zip
    168.6 KB · Affichages: 115
Dernière édition:

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonjour,
merci à tous pour vos propositions.
@Bernard : tout d'abord, la remarque de ton 1er message était bonne et mon code fonctionne bien si le format est précisé, ce qui donne :
Code:
Sub TriMultiColonne()
Dim tblo, Pl As Range, i&, j&, temp, t
't = Timer
Set Pl = Range("A2").CurrentRegion.Offset(1) _
.Resize(Range("A2").CurrentRegion.Rows.Count - 1)
tblo = Pl.Value
Dim tblo2() As String
ReDim Preserve tblo2(1 To Pl.Rows.Count)
For i = 1 To Pl.Rows.Count
    For j = 1 To Pl.Columns.Count
    If IsNumeric(tblo(i, j)) Then
        tblo2(i) = tblo2(i) & Format(tblo(i, j), "0000") & "#"
    Else
        tblo2(i) = tblo2(i) & tblo(i, j) & "#"
    End If
    Next j
Next i
temp = tblo2
Call tri(temp, LBound(temp), UBound(temp))
Dim tblo3()
ReDim Preserve tblo3(1 To Pl.Rows.Count)
For i = 1 To Pl.Rows.Count
    For j = 1 To Pl.Columns.Count
        tblo3(i) = Split(temp(i), "#")
    Next j
Next i
Range("M2").Resize(Pl.Rows.Count, Pl.Columns.Count) = _
Application.Transpose(Application.Transpose(tblo3))
'MsgBox Timer - t
End Sub
Sub tri(a, gauc, droi) ' Quick sort
Dim g&, d&, ref As String, temp As String
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      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
Concernant le module de classe, tout ce que je peux constater, c'est qu'il fonctionne sans problème. Après, je suis actuellement incapable d'en faire une étude plus poussée car il fait appel à des procédures que je ne comprends actuellement pas encore (module de classe avec utilisation de différentes fonctions, appel à une API Windows si je ne dis pas de bêtises,...).
L'étude de ce module sera l'occasion de découvrir ce pan de la programmation mais là il me faut un peu de temps:eek: !
Tout ce que je vois pour l'instant, c'est qu'il y a beaucoup de lignes de code et que c'est puissant...mais pour l'instant incapable de t'en dire plus.
Je vais rechercher des documents ou tutoriels sur les modules de classe et les API pour essayer d'en saisir l'intérêt.

@Job :
Sans se casser la tête, rien ne vaut un bon vieux tri sur feuille Excel
. Mon objectif est d'étudier la possibilité d'effectuer des tris sans travailler dans la feuille de calcul et sans être limité par le nombre de colonnes à trier, ce que ne permet pas l'utilisation du sort. Après bien sûr, en dehors de ma problématique, la performance du sort n'est plus à démontrer (cf. fichier joint).

@Jacques : tes 2 propositions m'ont beaucoup intéressé car elles abordent le cas du tri par concaténation comme je l'avais abordé, mais en montrant la possibilité de trier en définissant des priorités quel que soit l'ordre des colonnes du tableau (priorité 1 colonne 1 + priorité 2 colonne 3 dans ton cas), ce que ne permet pas mon code.

De plus elles m'ont éclairé un peu plus sur la manière de "jouer" avec le quick sort.

Concernant les temps de traitement, je ne retrouve pas sur l'ordinateur dont je me sers actuellement les temps que tu affiches mais cela reste très rapide (entre 0,20 sec et 0,40 sec en sur 5100 lignes en fonction du code (et les tests effectués sur le même code varient également selon le moment).

Bon, tes 2 propositions ne donnent pas le même résultat que celles de Bernard et le mien vu que l'objectif est différent, mais cela donne tout de même un aperçu.

Ci-joint un fichier test reprenant vos différentes propositions avec calcul du temps de traitement.
A+
 

Pièces jointes

  • TriMultiColonne_test.xls
    539 KB · Affichages: 133
  • TriMultiColonne_test.xls
    539 KB · Affichages: 162
  • TriMultiColonne_test.xls
    539 KB · Affichages: 155

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re pierrejean,
La macro de David ne tourne pas sous EXCEL 2000
cela doit être dû au double TRANSPOSE utilisé sur plus de 5000 lignes. Teste la macro sur 2000-3000 lignes (voire moins) pour voir STP.
La macro de job ne tourne pas sous EXCEL 2010
Parles-tu de celle que j'ai adaptée dans mon fichier test ou de l'originale du message #9 ?
As-tu testé son fichier du message #9 ?
A+
 
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re

En ce qui concerne la macro de job elle fonctionne parfaitement dans les 2 fichiers mais ......
dans le tien elle est troublée par la presence eventuelle du resultat de la macro de Jacques 2 because le currentregion
pas encore regardé ton double Transpose
 

Discussions similaires

Statistiques des forums

Discussions
312 191
Messages
2 086 052
Membres
103 109
dernier inscrit
boso_vs_viking