1 pièce(s) jointe(s)
Procédure de tri - Excel 2003-2010
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 |