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

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re
ci-joint nouveau fichier : modification de mon code qui doit maintenant fonctionner sur les différentes versions et décalage d'une colonne pour le test de la macro de Job afin que le CurrentRegion ne joue pas un mauvais tour.
A+
 

Pièces jointes

  • TriMultiColonne_test.xls
    549.5 KB · Affichages: 129
  • TriMultiColonne_test.xls
    549.5 KB · Affichages: 141
  • TriMultiColonne_test.xls
    549.5 KB · Affichages: 133

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re pierrejean

Franchement, je l'ai appris en testant pour réaliser ce code et effectivement, cela peut être utile de le savoir car cela peut permettre d'éviter l'utilisation d'une boucle qui pourrait rallonger le temps de traitement sur un tableau comportant un nombre important de colonnes à traiter.

Concernant ma proposition, on peut éventuellement économiser l'emploi de un array en se passant de temp qui ne sert qu'au tri :

Code:
Sub TriMultiColonne2()
Dim tblo, tblo2() As String, tblo3(), Pl As Range, i&, j&
Set Pl = Range("A2").CurrentRegion.Offset(1) _
.Resize(Range("A2").CurrentRegion.Rows.Count - 1)
tblo = Pl.Value
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
Call Tri(tblo2, LBound(tblo2), UBound(tblo2))
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(tblo2(i), "#")
    Next j
Next i
For i = 1 To Pl.Rows.Count
    For j = 1 To Pl.Columns.Count
        tblo(i, j) = tblo3(i)(j - 1)
    Next j
Next i
Range("F2").Resize(Pl.Rows.Count, Pl.Columns.Count) = tblo
End Sub
A+
 
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Dernière édition:

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re
Si le nombre de colonnes est important, la méthode avec index reste la + rapide puisque le tri s'effectue sur les clés seulement.
Exact !
Cf.fichier onglet 7_col avec une adaptation du code de Jacques (sur 20000 lignes et 7 colonnes).
A+
 

Pièces jointes

  • TriMultiColonne_test7col.zip
    874.5 KB · Affichages: 99

pascal82

XLDnaute Occasionnel
Re : Tri multicolonne sur tableau VBA

Bonjour à vous,

Je ne voudrait pas m'immiscer dans cette discussion très spécialisée mais j'aimerai apporter une petite variante au fichier proposé, si bien sur cela est possible naturellement.
Les différents tris proposés sont très intéressant, par contre ils ne prennent pas en compte les différents filtres, ou alors je n'ai pas tout compris. Je m'explique, colonne Prénom si je sélectionne filtre textuels, commence par prénom1 (même phénomène si Nom commence par Nom05 par exemple), et que je lance une macro de tri, alors il s'opère un classement total du fichier et non du tri sélectionné (prise en compte des cellules masquées).

La possibilité tri et prise en compte des filtres m'intéresse mais je suis incapable de la réaliser car mon niveau est trop faible.

Merci par avance
 

Efgé

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonjour à tous :),
Je suis passioné par ce fil, et je me permet une incursion;
Dans le fichier Test7Col, je pense que la macro de David peux façilement gagner en vitesse.
Je met en commentaire les lignes qui me semblent ralentir la procédure pour rien.
En espérant ne pas avoir dit de bétise :eek:.
VB:
For i = 1 To Pl.Rows.Count
    'For j = 1 To Pl.Columns.Count
        tblo3(i) = Split(tblo2(i), "#")
    'Next j
Next i
Cordialement
 

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re
@Efgé : bienvenu dans ce fil. Effectivement tu as raison. Le temps de traitement est réduit de 30% environ !
Ci-joint le fichier actualisé.
@Pascal82 : sur le principe, cela doit être possible de ne charger dans l'array que les lignes non filtrées. Je regarderai de mon côté quand j'aurai le temps et si quelqu'un n'est pas intervenu d'ici-là.
A+
 

Pièces jointes

  • TriMultiColonne_test7col_v2.zip
    874.5 KB · Affichages: 43

Efgé

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re à tous,
@ David
J'ai continué mes recherches, j'ai diminué le temps de traitement, sans arriver au niveau de Bernard...
Je laisse quand même le résultat
VB:
Sub TriMultiColonne3()
Dim tblo, tblo2(), tblo3, Pl As Range, i&, j&, T!
T = Timer
tblo = Range("A2").CurrentRegion.Offset(1) _
.Resize(Range("A2").CurrentRegion.Rows.Count - 1)
ReDim tblo2(1 To UBound(tblo, 1))
For i = 1 To UBound(tblo, 1)
    For j = 1 To UBound(tblo, 2)
        If IsNumeric(tblo(i, j)) Then
            tblo2(i) = tblo2(i) & Format(tblo(i, j), "00000") & "#"
        Else
            tblo2(i) = tblo2(i) & tblo(i, j) & "#"
        End If
    Next j
Next i
Call Tri(tblo2, LBound(tblo2), UBound(tblo2))
For i = 1 To UBound(tblo, 1)
    tblo3 = Split(tblo2(i), "#")
    For j = 1 To UBound(tblo, 2)
        tblo(i, j) = tblo3(j - 1)
    Next j
Next i
Range("I2").Resize(UBound(tblo, 1), UBound(tblo, 2)) = tblo
MsgBox Timer - T
End Sub
Cordialement
 

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re
@Efgé : j'ai pris en compte tes modifications.
@pascal82 : comme je n'arrive pas à trouver un moyen simple et rapide de charger les plages filtrées directement dans l'array, à mon avis, le plus simple est de copier la plage filtrée sur une autre feuille et de travailler ensuite comme indiqué précédemment (mais peut-être que quelqu'un trouvera une autre solution) :
le code utilisé est celui de Jacques, les résultats sont dans la feuille Resultat.
J'ai dû enlever les autre codes du fichier TriMulticolonneFiltre car sinon trop lourd, même zippé.
Bernard, si tu veux proposer une version "filtre" de ton code, ne te gène pas:).
A+
 

Pièces jointes

  • TriMultiColonne_test7col_v3.zip
    868.8 KB · Affichages: 34
  • TriMultiColonne_test7colFiltre.zip
    964.6 KB · Affichages: 32

Dranreb

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Je suppose que tu t'adresse à moi, moi c'est Dranreb. Alias Karl CUBREND, alias Bud CLARKNER.
Bernard est un prénom (mon vrai, je l'admets) tellement répandu...
Bref. Je pense qu'il faut travailler par paquets à partir de la plage filtrée et verser par des boucles dans un autre tableau unique.
SpecialCells(xlCellTypeVisible) rend un Range à plusieurs Areas
donc: For Each PlgPaquet In PlgFiltre.Areas
Là on peut se charger PlgPaquet.Value dans un tableau de variant, et on ajoute en mémoire chaque élément dans un autre tableau.
Après on peut classer celui ci comme s'il était tout de suite venu d'un seul tenant.
Cordialement.
 
Dernière édition:

BOISGONTIER

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

Bonjour,


Code:
Sub recupZoneFiltréeDansTableau()
    Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
      Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy [G1]
    a = [G1].CurrentRegion   ' tableau a(,)
    [G1].CurrentRegion.Clear
End Sub

JB
 

Pièces jointes

  • RecupZoneFiltreeTableau.xls
    27 KB · Affichages: 53

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonjour,
un essai pour récupérer les lignes non filtrées dans un array au lieu de le recopier (le résultat final est envoyé dans la feuille Resultat pour qu'il soit plus lisible) :
Code:
Sub TriTableau2DFiltre2()
'T = Timer()
Dim clé() As String, index() As Long
Sheets("Resultat").[A2:G21000].ClearContents
Set Pl = [A1].CurrentRegion: Set Pl = Pl.Rows(2).Resize(Pl.Rows.Count - 1)
Set plvisible = Pl.SpecialCells(xlVisible)
Nb = plvisible.Cells.Count \ Pl.Columns.Count 'trouver un autre moyen de récupérer le nombre de lignes filtrées
L = 1
Dim tabfiltre(), a()
For i = 1 To plvisible.Areas.Count
    tabfiltre = plvisible.Areas(i).Value
    ReDim Preserve a(1 To Nb, 1 To Pl.Columns.Count)
    For j = 1 To UBound(tabfiltre)
        For k = 1 To Pl.Columns.Count
            a(L, k) = tabfiltre(j, k)
        Next k
        L = L + 1
    Next j
Next i
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)
    For j = 1 To UBound(a, 2)
        If IsNumeric(a(i, j)) Then
            clé(i) = clé(i) & Format(a(i, j), "00000")
        Else
            clé(i) = clé(i) & a(i, j)
        End If
    Next j
    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
Sheets("Resultat").[A2].Resize(UBound(b), UBound(b, 2)) = b
'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
Cela semble fonctionner mais il faudrait trouver un autre moyen de récupérer le nombre de lignes filtrées que
Code:
Nb = plvisible.Cells.Count \ Pl.Columns.Count
Code:
Nb = plvisible.rows.Count
me renvoie 1
A+
 

Pièces jointes

  • TriMultiColonne_test7colFiltre2.zip
    967.2 KB · Affichages: 42

Dranreb

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Bonjour.
Il auraient été sympa de prévoir que le paramètre Destination puisse être un tableau de Variant.
Donc si je ne veux pas passer par une feuille de calcul:
VB:
Sub ValoriserFiltre(TSorti() As Variant, ByVal F As Worksheet)
Dim PlgF As Range, LMax As Long, CMax As Long, C As Long, L As Long, Zone As Range, TEntré() As Variant
Set PlgF = F.AutoFilter.Range
Set PlgF = PlgF.Rows(2).Resize(PlgF.Rows.Count - 1)
Set PlgF = PlgF.SpecialCells(xlCellTypeVisible)
LMax = 0: CMax = PlgF.Columns.Count
For Each Zone In PlgF.Areas
   LMax = LMax + Zone.Rows.Count
   Next Zone
ReDim TSorti(1 To LMax, 1 To CMax) As Variant
LMax = 0
For Each Zone In PlgF.Areas
   TEntré = Zone.Value
   For L = 1 To UBound(TEntré, 1): LMax = LMax + 1
      For C = 1 To CMax: TSorti(LMax, C) = TEntré(L, C): Next C
      Next L
   Next Zone
End Sub
'

Sub essai()
Dim T() As Variant
ValoriserFiltre T, ActiveSheet
Debug.Print T(1, 1), T(1, 2)
Debug.Print T(2, 1), T(2, 2)
Stop
End Sub
 

david84

XLDnaute Barbatruc
Re : Tri multicolonne sur tableau VBA

Re Dranreb
Comme j'ai vu que tu utilisais un compteur pour ramener le nombre de lignes filtrées, j'adopte l'idée plutôt que de passer par
Code:
Nb = plvisible.Cells.Count \ Pl.Columns.Count
.
Le code proposé devient donc :
Code:
Sub TriTableau2DFiltre2()
'T = Timer()
Dim clé() As String, index() As Long
Sheets("Resultat").[A2:G21000].ClearContents
Set Pl = [A1].CurrentRegion: Set Pl = Pl.Rows(2).Resize(Pl.Rows.Count - 1)
Set plvisible = Pl.SpecialCells(xlVisible)
For Each Zone In plvisible.Areas
   LMax = LMax + Zone.Rows.Count
Next Zone
L = 1
Dim tabfiltre(), a()
For i = 1 To plvisible.Areas.Count
    tabfiltre = plvisible.Areas(i).Value
    ReDim Preserve a(1 To LMax, 1 To Pl.Columns.Count)
    For j = 1 To UBound(tabfiltre)
        For k = 1 To Pl.Columns.Count
            a(L, k) = tabfiltre(j, k)
        Next k
        L = L + 1
    Next j
Next i
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)
    For j = 1 To UBound(a, 2)
        If IsNumeric(a(i, j)) Then
            clé(i) = clé(i) & Format(a(i, j), "00000")
        Else
            clé(i) = clé(i) & a(i, j)
        End If
    Next j
    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
Sheets("Resultat").[A2].Resize(UBound(b), UBound(b, 2)) = b
'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
A+
 

Discussions similaires

Statistiques des forums

Discussions
312 307
Messages
2 087 096
Membres
103 468
dernier inscrit
TRINITY