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

pascal82

XLDnaute Occasionnel
Re : Tri multicolonne sur tableau VBA

Bonjour à tous,

Un grand merci à vous tous pour avoir tenu compte de ma demande, comme d'habitude le fichier répond parfaitement à ce que j'ai besoin et le tout en un temps record.
Pour info chez moi le temps de traitement est voisin de 0.3 s, c'est une sacrée performance.

Très cordialement
 

BOISGONTIER

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

Bonsoir,

-J'ai constaté sur Excel 2002 que le transfert de dates (présentes dans un Array() ) vers le tableur avec

[I2].resize(Ubound(a,1),ubound(a,2))=a

posait un problème d'inversion jour/mois pour certaines dates (31/12/1012 par ex qui devient 12/31/2012)

-Ce problème n'existe pas pour 2007

-Le transfert de dates d'un dictionnaire vers le tableur est ok en 2002 et 2007

Pourriez vous, svpm confirmer si c'est bien le cas sur vos postes?

JB
 

Pièces jointes

  • TriTableau2DIndex2Crit.xls
    357.5 KB · Affichages: 76
  • TriTableau2DIndex2CritDates.xls
    270 KB · Affichages: 58

Dranreb

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonsoir
J'ai les mêmes anomalies mystérieuses chez moi.
Jour et mois sont intervertis partout dans TriTableau2DIndex2Crit.xls, et du coup "12/31/2011" et "1/28/2012" sont du texte.
Est-ce à rapprocher de l'inexplicable obligation d'utiliser parfois CDate pour récupérer des valeurs de cellules qui sont déjà des dates ?

P.s. Et un remède empirique, emprunté à une utilisation possible que vous m'avez apprise, ne fait qu’épaissir le mystère:
VB:
 [H2].Resize(UBound(b), UBound(b, 2)).Value = b    ' Attention! pas de dates dans le champ
 [K2].Resize(UBound(b)).Value = WorksheetFunction.index(b, 0, 4)
Cordialement.
 
Dernière édition:

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonjour,
Etant sur 2007, pas besoin pour moi de passer par un dictionnaire ou d'utiliser la proposition de Dranreb.
Mais ces 2 méthodes sont effectivement intéressantes à connaître pour des problèmes évidents de compatibilités entre les versions.
Bon, là on s'en sort grâce à l'utilisation de l'index.
Concernant, un tableau à 1 colonne avec des dates à trier et hormis l'utilisation de Index, la seule solution fonctionnelle testée chez moi consiste à charger l'array, passer les dates au format standard, effectuer le tri et les repasser au format Date avant l'affichage dans la feuille.
Code:
Sub TriDate()
Dim temp()
tablo = [A1:A400].Value
ReDim temp(LBound(tablo) To UBound(tablo))
For i = LBound(tablo) To UBound(tablo)
temp(i) = Format(tablo(i, 1), "00000") 'passer les dates au format de nombre "General"
Next i
Call tri2(temp, LBound(temp), UBound(temp))
For i = LBound(tablo) To UBound(tablo)
temp(i) = Format(temp(i), "m/d/yyyy") 'repasser les dates au format de nombre Date courte
Next i
[B1].Resize(UBound(temp)) = Application.Transpose(temp)
End Sub

Sub tri2(a, gauc, droi) ' Quick sort
  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 tri2(a, g, droi)
  If gauc < d Then Call tri2(a, gauc, d)
End Sub

Ci-joint fichier à tester avec :
- tri d'une plage de dates
- tri d'une plage multicolonne avec dates : feuille "version 2007" et la même version agrémentée de la proposition de Dranreb (mais la proposition avec Dictionary fonctionne également bien entendu).

Le fait de pouvoir trier des dates (ou toute autre donnée nécessitant un format d'affichage dans une feuille Excel) me paraît être une avancée très intéressante dans l'utilisation des arrays.
A souligner également que le code fourni par Dranreb au début de ce fil est fonctionnel tel quel sur le tri multicolonne incluant des dates sur la version 2007 (à tester de votre côté sur les autres versions).
A+
 

Pièces jointes

  • Tri_dates.zip
    237.4 KB · Affichages: 41
  • Tri_dates.zip
    237.4 KB · Affichages: 44
  • Tri_dates.zip
    237.4 KB · Affichages: 43

carlos

XLDnaute Impliqué
Supporter XLD
Re : Tri multicolonne sur tableau VBA

Bonjour à tous

Merci pour ce fil.
C'est un peu dur pour mon niveau mais ca permet d'avancer .

J'ai 2 questions ;
La premiere question
Sur le fichier joint , en reprenant le code de tri du fil , j'arrive à trier mes noms sans probleme.
Par contre ma colonne 2 qui est en nombre ne se trie pas bien .
Ca donne par exemple :
1
13
2
26
5
Comment trier par :
1
2
5
13
26
comment faire ?

La deuxieme question .
coment trier cette liste en décroissant ?

Merci pour vos réponses .

Carlos
 

Pièces jointes

  • Tri multicolonnes nombre et texte.xlsm
    24.9 KB · Affichages: 47

BOISGONTIER

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

Bonjour,

Voir pj

Code:
Private Sub OptionButton1_Click()
   Dim a()
   a = Me.ListBox1.List
   nbcol = UBound(a, 2) - LBound(a, 2) + 1
   Call tri(a(), LBound(a), UBound(a), nbcol, 0, 0)
   Me.ListBox1.List = a
End Sub

Private Sub OptionButton2_Click()
   Dim a()
   a = Me.ListBox1.List
   nbcol = UBound(a, 2) - LBound(a, 2) + 1
   Call tri(a(), LBound(a), UBound(a), nbcol, 1, 1)
   Me.ListBox1.List = a
End Sub

Sub tri(a(), gauc, droi, nbcol, colTri, num)       ' Quick sort
 ref = a((gauc + droi) \ 2, colTri)
 If num = 1 Then ref = CDbl(ref)
 g = gauc: d = droi
 Do
     If num = 1 Then tmp = CDbl(a(g, colTri)) Else tmp = a(g, colTri)
     Do While tmp < ref
       g = g + 1: If num = 1 Then tmp = CDbl(a(g, colTri)) Else tmp = a(g, colTri)
     Loop
     If num = 1 Then tmp = CDbl(a(d, colTri)) Else tmp = a(d, colTri)
     Do While ref < tmp
       d = d - 1: If num = 1 Then tmp = CDbl(a(d, colTri)) Else tmp = a(d, colTri)
     Loop
     If g <= d Then
       For c = 0 To nbcol - 1
         temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call tri(a, g, droi, nbcol, colTri, num)
 If gauc < d Then Call tri(a, gauc, d, nbcol, colTri, num)
End Sub

Autre solution: Tri multi-critères multi-colonnes Classement+Nom

clé(i) = Format(CDbl(a(i, 1)), "00000") & a(i, 0): index(i) = i

Code:
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

Private Sub OptionButton2_Click()
   'Tri multi-critères multi-colonnes Classement+Nom
   Dim clé() As String, index() As Long
   Dim a()
   a = Me.ListBox1.List
   Dim b()
   ReDim b(LBound(a) To UBound(a), LBound(a, 2) To UBound(a, 2))
   ReDim clé(LBound(a) To UBound(a, 1))
   ReDim index(LBound(a) To UBound(a, 1))
   For i = LBound(a) To UBound(a, 1)
    clé(i) = Format(CDbl(a(i, 1)), "00000") & a(i, 0): index(i) = i
   Next i
   Call Tri(clé(), index(), LBound(a), UBound(clé))
   For lig = LBound(clé) To UBound(clé)
      For col = LBound(a, 2) To UBound(a, 2): b(lig, col) = a(index(lig), col): Next col
   Next lig
   Me.ListBox1.List = b
End Sub

Tri avec index

JB
 

Pièces jointes

  • Copie de Tri multicolonnes nombre et texte2.xlsm
    27 KB · Affichages: 82
  • Copie de Tri multicolonnes nombre et texte-1.xlsm
    26.6 KB · Affichages: 58
Dernière édition:

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonjour,
Dans le cadre de ce fil que j'avais initié, ci-joint une adaptation d'un algorithme de tri de Donald L.Shell.
3 procédures vous sont proposées dans le fichier joint :
- La sub Tri_1Col permet de trier un Array à 1 dimension.
- La sub Tri_MultiCol permet de trier un Array à 2 dimensions (l'objet initial de ce fil).
- La Sub Tri_3_clés permet de trier un Array à 2 dimensions dans un sens ascendant ou descendant avec la possibilité d'individualiser le sens de tri selon les colonnes.
Les codes et explications sont dans ce fichier.

A+
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa