Procédure de tri - Excel 2003-2010

[Philippe Tulliez]

Bonjour,
J'avais écrit en son temps une procédure de tri, basée sur 'Une feuille = une Table' et commençait en cellule A1.
Cette discussion m'a donné l'idée de développer une procédure plus souple qui permet de répondre à plus de situation.
Cette procédure est basée sur l'ancienne méthode SORT, limitée à 3 niveaux de tri parce-que je veux garder une portabilité avec la version 2003.
SortTable(Table As Range, Optional lstCol As String, Optional sHeader As Byte = xlGuess, Optional Extend As Boolean = True). Exemple SortTable Range("A1").
Les arguments :
Table de type Range. Représente la cellule ou plage de cellules à trier. Si une seule cellule est référencée, la référence est étendue aux cellules contigües (cf Ctrl+*) sauf si l'argument Extend est à FALSE.
[lstCol] de type String contient la liste des colonnes à trier (maximum de 3), séparé par un point virgule. Le tri est Ascendant par défaut sauf si un n° de colonne est négatif.
Si lstCol est omis, c'est la première colonne de la table qui sera trié. Exemple : lstCol:="1;-6;-4". Dans cet exemple, le tri est descendant pour les colonnes 6 et 3.
[sHeader] type Byte. Défini si la table à un en-tête. (xlGuess par défaut).
[Extend] de type Boolean. Indique si la référence à la table doit être étendue aux cellules contigües. La valeur par défaut est TRUE.
Pour résumé, si un seul argument est donné.
Exemple :
Dans l'exemple, nous considérons que la feuille est représentée pas la variable objet sht et que la plage contigüe s'étend de A1 à H100

Code :

1
2
Dim  sht as WorkSheet
SortTable sht.Range("$A$1")

Le tri se fera croissant sur la première colonne de la plage $A$1:$H$100, la première ligne du tableau ne sera pas triée (En-tête).
Le classeur SortDemo.xls contient quelques exemples.
Malgré le soin que j'ai apporté au développement de la procédure, au classeur exemple et aux nombreux tests, il est possible qu'il y ait un bug non rencontré.
J'ai moi-même perdu une image que j'ai dû reconstituer en passant de la version 2010 à 2003. J'en ignore la raison.
J'ai également eu un soucis de tri après plusieurs tests, et ce sans raison apparente.
Si vous avez des remarques n'hésitez pas.
Le code Testé sur les versions 2003 et 2010

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Option Explicit
Public Sub SortTable(Table As Range, Optional lstCol As String, Optional sHeader As Byte = xlGuess, Optional Extend As Boolean = True)
 ' Procédure de Tri - fonctionne avec les versions 2003-2010
 ' Author  : Philippe Tulliez
 ' Date    : 12-03-27
 ' Version : 1.3
 ' Arguments
 ' Table    - Range fait référence à la feuille et à la plage à trier
 ' [lstCol] - String Liste des colonnes à trier séparé par un point virgule. Si n° négatif, tri descendant
 '            par défaut première colonne de la table. Exemple lstCol:="2;4;-6"
 ' [sHeader]- Défini si la table à une en-tête. (xlGuess pas défaut).
 ' [Extend] - Boolean. Indique si la référence à la table doit être étendue (Cas de colonne unique contigüe). True par défaut
 Const ErrTitle As String = "Procédure - SortTable":
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 ' dim ErrArgList = "Arguments " & vbCrLf & vbTab & "Table = " & Table.Address
 Dim tCol() As String, c As Long
 Dim pSort(1 To 3) As Byte, rCol(1 To 3) As String
 Application.ScreenUpdating = False
 Dim sht As Worksheet: Set sht = ActiveSheet: Table.Parent.Activate
 c = Table.Column
 Select Case Table.Count ' Table = une cellule
  Case 1
   If Extend Then
     Set Table = Table.CurrentRegion: If Len(lstCol) = 0 Then lstCol = c - Table.Column + 1
    Else
     With sht: Set Table = .Range(.Cells(Table.Row, Table.Column), .Cells(Table.End(xlDown).Row, Table.Column)): End With
   End If
  Case Else
   If Extend Then Set Table = Table.CurrentRegion
 End Select
 If Table.Cells.Count = 1 Then
  MsgBox ErrMsg & "Problème plage " & vbCrLf & Table.Parent.Name & " " & Table.Address, vbCritical, ErrTitle: Exit Sub
 End If
 If Len(lstCol) = 0 Then lstCol = Cells.Column ' Si  lstCol vide -> lstCol = première colonne du tableau
 tCol = Split(lstCol, ";")
 For c = 0 To UBound(tCol) - (Abs((UBound(tCol) > 3) * (UBound(tCol) - 3))) ' Maximum 3 niveaux de tri
  With Table
   If Val(tCol(c)) = 0 Then tCol(c) = 1 ' Si Colonne 0 alors Colonne 1
   If Abs(tCol(c)) + .Column - 1 < .Column Or Abs(tCol(c)) + .Column - 1 >= .Column + .Columns.Count Then
     ' Message d'erreur si colonne à trier > nbre colonnes de la table et sortie du tri
     MsgBox ErrMsg & "Impossible de trier la colonne " & Abs(tCol(c)) _
       & vbCrLf & "La plage " & Table.Address & " de la feuille " & Table.Parent.Name _
       & vbCrLf & "ne contient que " & .Columns.Count & " colonnes", vbCritical, ErrTitle
     Exit Sub ' Sortie du tri
   End If
   If Val(tCol(c)) < 0 Then pSort(c + 1) = xlDescending Else pSort(c + 1) = xlAscending
   rCol(c + 1) = Cells(.Row + 1, .Column + Abs(tCol(c)) - 1).Address
  End With
 Next c
 If UBound(tCol) < 2 Then
  For c = UBound(tCol) + 1 To 2: rCol(c + 1) = rCol(c): pSort(c + 1) = pSort(c): Next
 End If
 With Table  ' 2 - Tri
  .Sort _
    Key1:=Range(rCol(1)), Order1:=pSort(1), _
    Key2:=Range(rCol(2)), Order2:=pSort(2), _
    Key3:=Range(rCol(3)), Order2:=pSort(3), _
    Header:=sHeader, OrderCustom:=1, MatchCase:=False
 End With
 sht.Activate ' Focus sur Feuille Active avt Procédure
 Application.ScreenUpdating = True
End Sub

[casefayere]

Bonjour Philippe,

Je n'ai pas le temps de tester (je suis sur autre chose), mais de toutes façon, bravo pour ce travail et pour tout ce que tu donnes en disponibilité par ailleurs.

Dès que je le peux, je reviendrai tester ta contribution et te dirai ce que j'en pense.

Je complète ce message car j'ai fait l'essai, aucun problème sinon que, mais tout le monde le devinera, j'ai ajouté le nom de ma feuille

Code :

1
2
3
Dim sht As Worksheet
Set sht = Sheets("references")
SortTable sht.Range("$A$1")

Bon Dimanche et bonne continuation.

Cordialement,

[Philippe Tulliez]

Bonjour Dominique,
Merci pour ton appréciation cela fait toujours plaisir.
Cordialement
Philippe

[PatrickMomal]

Merci de cette démo très complète.

En fait j'ai réussi par le simple Range.Sort.
Comme je n'avais pas utilisé cette commande, je me suis fié à la doc MS qui dit que Key1:=
est 'optional'.
En réalité, dans mon cas, ça ne l'est pas : ça ne marche pas sans, mais ça marche avec...