+ Répondre à la discussion
Affichage des résultats 1 à 4 sur 4
  1. #1
    Expert Confirmé Sénior

    Homme Profil pro
    .
    Inscrit en
    janvier 2010
    Messages
    5 018
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : .

    Informations forums :
    Inscription : janvier 2010
    Messages : 5 018
    Points : 11 288
    Points
    11 288
    Billets dans le blog
    1

    Par défaut 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
    Fichiers attachés Fichiers attachés
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)

    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes dernières contributions : Comment imbriquer une formule dans une formule à l'aide de la boîte de dialogue Insertion de fonction ? - Géolocalisation d'une adresse avec Excel et Google sans VBA

  2. #2
    Expert Confirmé Sénior Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    décembre 2006
    Messages
    4 000
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 60
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : décembre 2006
    Messages : 4 000
    Points : 8 354
    Points
    8 354

    Par défaut

    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,
    Cordialement,
    Dom

    N'oubliez pas que les membres qui vous répondent sont des participants bénévoles !
    Merci de votre visite et ... n’oubliez pas le guide, en cliquant (en bas des réponses) sur si content, sur rien du tout si pas satisfait, sinon sur si pas content mais alors pas content du tout

  3. #3
    Expert Confirmé Sénior

    Homme Profil pro
    .
    Inscrit en
    janvier 2010
    Messages
    5 018
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : .

    Informations forums :
    Inscription : janvier 2010
    Messages : 5 018
    Points : 11 288
    Points
    11 288
    Billets dans le blog
    1

    Par défaut

    Bonjour Dominique,
    Merci pour ton appréciation cela fait toujours plaisir.
    Cordialement
    Philippe
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)

    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes dernières contributions : Comment imbriquer une formule dans une formule à l'aide de la boîte de dialogue Insertion de fonction ? - Géolocalisation d'une adresse avec Excel et Google sans VBA

  4. #4
    Invité de passage
    Homme Profil pro
    Responsable des études
    Inscrit en
    octobre 2012
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations professionnelles :
    Activité : Responsable des études
    Secteur : Industrie

    Informations forums :
    Inscription : octobre 2012
    Messages : 2
    Points : 4
    Points
    4

    Par défaut Merci !

    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...

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •