Trieur de tableau sur plusieurs colonnes

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 194 fois - Téléchargée 18 fois

Contenu du snippet

Cette classe d'objet permet de trier un tableau à une ou deux dimensions sur une ou plusieurs colonnes

Source / Exemple :


Option Explicit
'Auteur : Florent Bénetière, tnerolf@lekod.com
'Cette classe d'objet permet de trier un tableau à une ou deux dimensions sur une ou plusieurs colonnes

'****************************************************************
'*                          !!CONTRAINTE !!                     *
'*    Le contenu d'une "case" du tableau ne doit pas être Nul   *
'*                Les valeurs vides sont autorisées             *
'****************************************************************

'****************************************************************
'*                         !! PRE REQUIS !!                     *
'*  La bibliothèque Microsoft VBScript Regular Expressions 5.5  *
'*                [Chemin vers Windows]\System32\vbscript.dll   *
'****************************************************************
    
Private NbreLignes As Integer 'Nombre de lignes du tableau à trier
Private NbreColonnes As Byte 'Nombre de colonnes du tableau à trier
Private NbreDimensions As Byte 'Nombre de dimensions du tableau (1 ou 2)
Private TableauATrier As Variant 'Le tableau à trier
Private TblColonnesTri() As String 'Tableau contenant les numéros des colonnes du tableau sur lesquels
'effectuer un tri. Sa structure est TblColonnesTri[Numéro de colonne][Ordre de Tri]
'[Ordre de Tri] est soit "ASC" soit "DESC". S'il n'est pas renseigné, il prend la valeur "ASC"

Private TblFinal As Variant 'Tableau renseigné au fur et à mesure des tris sur les colonnes

Private PrecisionDecimal As Integer 'Détermine combien de décimales on doit afficher pour les nombres

Property Let AttribueTableau(Tableau As Variant)
Dim a As Integer, b As Integer

TableauATrier = Tableau
DetermineDimensions

'Si le tableau n'a qu'une seule dimension, on a pas besoin d'initialiser TblFinal car le tri
'TableauATrier ne s'appuiera pas sur TblFinal pour se faire

'On initialise TblFinal et on le remplit avec des "*"
'Cela permettra d'élaborer ultérieurement les motifs afin de respecter les ordres de tri
'en fonction des colonnes choisies
If NbreDimensions = 2 Then
    ReDim TblFinal(NbreColonnes, NbreLignes)
    
    For a = 0 To NbreLignes
        For b = 0 To NbreColonnes
            TblFinal(b, a) = "*"
        Next b
    Next a
End If
End Property

Property Get TableauTrie() As Variant
'Cette propriété renvoie le tableau TableauATrier une fois ce dernier
'trié par les colonnes et les sens de tri du tableau TblColonnesTri

Dim LigneTri As Integer, TailleTri As Integer, LigneTableau As Integer, Colonne As Byte
Dim TblColonne As Variant, Motif As String

If NbreDimensions = 1 Then
'Là, c'est facile, il n'y a qu'une colonne
    TableauTrie = TriSurUneColonne(TableauATrier, TblColonnesTri(1, 0))
    Exit Property
End If

TailleTri = UBound(TblColonnesTri, 2)
If TailleTri > 0 Then TailleTri = TailleTri - 1 '-1 car dernière colonne de TblColonnesTri est toujours vide

'On trie uniquement la colonne visée
'(1) On remplit TblColonne avec les valeurs contenues dans la colonne visée
'(2) On la trie
'(3) On renseigne TblFinal avec les valeurs de TblColonne

For LigneTri = 0 To TailleTri
    ReDim TblColonne(NbreLignes)
    '(1)
    For LigneTableau = 0 To NbreLignes
        TblColonne(LigneTableau) = TableauATrier(TblColonnesTri(0, LigneTri), LigneTableau)
    Next LigneTableau
    '(2)
    TblColonne = TriSurUneColonne(TblColonne, TblColonnesTri(1, LigneTri))

    For LigneTableau = 0 To NbreLignes
        '(3)
        RemplitTblFinal TblColonne(LigneTableau), CByte(TblColonnesTri(0, LigneTri))
    Next LigneTableau
Next LigneTri

'Maintenant, on se charge de remplir toutes les cases non renseignées de TblFinal
'En parcourant TableauATrier et en élaborant les motifs
For LigneTableau = 0 To NbreLignes
    CombleTblFinal LigneTableau
Next LigneTableau
TableauTrie = TblFinal
End Property

Property Let NbreDecimales(Decimales As Integer)
    PrecisionDecimal = Abs(Decimales)
End Property

Property Get PrecisionDecimales()
    NbreDecimales = PrecisionDecimal
End Property

Public Sub AjouteColonneTri(NumCol As Byte, Optional SensTri As String = "ASC")
'Cette procédure ajoute une colonne de tri au tableau TblColonnesTri
Dim Taille As Byte

Taille = UBound(TblColonnesTri, 2)

TblColonnesTri(0, Taille) = NumCol: TblColonnesTri(1, Taille) = IIf(SensTri <> "DESC", "ASC", "DESC")

ReDim Preserve TblColonnesTri(1, Taille + 1)
End Sub

Public Sub SupprimeColonneTri(NumCol As Byte)
'Cette procédure supprime du tableau TblColonnesTri la ligne correspondant à Numcol
Dim Ligne As Byte, Compteur As Byte, Taille As Byte, TblTemp() As String

Taille = UBound(TblColonnesTri, 2)
ReDim TblTemp(1, 0)

For Ligne = 0 To Taille
    If TblColonnesTri(0, Ligne) <> vbNullString Then
        If TblColonnesTri(0, Ligne) <> NumCol Then
            TblTemp(0, Compteur) = TblColonnesTri(0, Ligne)
            TblTemp(1, Compteur) = TblColonnesTri(1, Ligne)
            
            Compteur = Compteur + 1
            
            ReDim Preserve TblTemp(1, Compteur)
        End If
    End If
Next Ligne

TblColonnesTri = TblTemp
End Sub

Public Sub ModifieColonneTri(NumColCible As Byte, NvlleColonne As Byte, Optional SensTri As String = "ASC")
'Cette procédure modifie le numéro et / ou le sens du tri de la ligne NumColCible du tableau TblColonnesTri
Dim Taille As Byte, Ligne As Byte

Taille = UBound(TblColonnesTri, 2)

For Ligne = 0 To Taille
    If TblColonnesTri(0, Ligne) = NumColCible Then
        TblColonnesTri(0, Ligne) = NvlleColonne
        TblColonnesTri(1, Ligne) = IIf(SensTri <> "DESC", "ASC", "DESC")
        Exit For
    End If
Next Ligne
End Sub

Private Sub Class_Initialize()
ReDim TblColonnesTri(1, 0)
PrecisionDecimal = 20
End Sub

Private Sub DetermineDimensions()
'Cette procédure regarde combien de dimensions a le tableau TableauATrier
On Error GoTo Erreurs

NbreDimensions = UBound(TableauATrier, 2)
'Si on arrive à ce stade, c'est qu'il n'y a pas eu d'erreur, donc que le tableau a deux diemnsions
NbreDimensions = 2
NbreLignes = UBound(TableauATrier, 2)
NbreColonnes = UBound(TableauATrier)
Exit Sub

Erreurs:
If Err.Number = 9 Then 'L'indice n'appartient pas à la sélection
    'S'il y a eu une erreur, c'est que le tableau n'a qu'une seule dimension
    NbreDimensions = 1
    NbreLignes = UBound(TableauATrier)
Else
MsgBox Err.Description, vbCritical, "Erreur N° " & Err.Number
End If
End Sub

Private Function TriSurUneColonne(TblColonne As Variant, SensTri As String) As Variant
'Cette fonction retourne TblColonne trié par le sens SensTri
'SensTri peut être "ASC" ou "DESC"
Dim TblTemp As Variant, Ligne1 As Integer, Ligne2 As Integer, Ligne3 As Integer, Colonne As Byte, LigneRetenue As Integer
Dim NbreLignesVerifiees As Integer, Taille As Integer

'LigneRetenue permet de retenir de toutes les valeurs du tableau laquelle est la plus petite ou la plus grande
ReDim TblTemp(0)

Do
    NbreLignesVerifiees = 0

    For Ligne1 = 0 To NbreLignes
        If IsNull(TblColonne(Ligne1)) Then
            NbreLignesVerifiees = NbreLignesVerifiees + 1
            If NbreLignesVerifiees = NbreLignes Then 'On remplit TblTemp avec la dernière valeur restante
                For Ligne3 = 0 To NbreLignes
                    If Not IsNull(TblColonne(Ligne3)) Then TblTemp(NbreLignes) = TblColonne(Ligne3)
                Next Ligne3
                
                Exit Do
            End If
        Else
            LigneRetenue = Ligne1

            For Ligne2 = 0 To NbreLignes
                If Ligne1 <> Ligne2 And Not IsNull(TblColonne(Ligne2)) Then
                    If SensTri = "ASC" Then
                        If TblColonne(Ligne2) <= TblColonne(LigneRetenue) Then LigneRetenue = Ligne2
                    Else
                        If TblColonne(Ligne2) >= TblColonne(LigneRetenue) Then LigneRetenue = Ligne2
                    End If
                    'On est obligé de faire <= ou >= au cas où il n'y ait dans le tableau que des valeurs identiques
                    'Si on ne mettait pas <= ou >=, on se retrouverait avec une boucle infinie dans le Do
                End If
            Next Ligne2
            Exit For 'On a comparé la première valeur non nulle de la boucle Ligne1 avec toutes celles
            'de la boucle Ligne2 => On sort de la boucle Ligne1 car on a la valeur la plus petite ou la plus grande
        End If
    Next Ligne1
    
    'On affecte la valeur à TblTemp et on vide la cellule du tableau ayant été matchée
    TblTemp(Taille) = TblColonne(LigneRetenue)
    Taille = Taille + 1
    ReDim Preserve TblTemp(Taille)
    
    TblColonne(LigneRetenue) = Null
Loop
'On ne garde pas la dernière ligne s'il n'y a rien dedans
If IsEmpty(TblTemp(Taille)) Then ReDim Preserve TblTemp(Taille - 1)
TriSurUneColonne = TblTemp
End Function

Private Sub RemplitTblFinal(Val_a_InclureDsMotif As Variant, ColonneMotif As Byte)
'Cette procédure remplace le "*" initial du tableau TblFinal par la valeur contenue dans TableauATrier

'On construit le motif qui servira à indiquer où mettre la valeur Val_a_InclureDsMotif dans TblFinal
'Pour cela on concatène chaque valeur des colonnes de TblFinal de la Ligne de TblFinal
'sauf pour celle correspondant à ColonneTblFinal, qui elle, est remplacée par Val_a_InclureDsMotif
Dim Colonne As Byte, Ligne1 As Integer, Ligne2 As Integer, Motif As String, LigneConcatenee As String
Dim Drapeau As Boolean

For Ligne1 = 0 To NbreLignes 'TblFinal
    'On construit le motif
    Motif = ConcateneLigne(Ligne1, , ColonneMotif, Val_a_InclureDsMotif)

    For Ligne2 = 0 To NbreLignes 'TableauATrier
        'Maintenant qu'on a le motif, on construit une concaténation de Ligne2 qui est la ligne en cours TableauATrier
        LigneConcatenee = ConcateneLigne(Ligne2, "TableauATrier")
        
        'Au premier match, on remplit TblFinal avec Val_a_InclureDsMotif
        'si et seulement si le contenu de la case de TblFinal est égal à "*"
        If LigneConcatenee Like Motif And TblFinal(ColonneMotif, Ligne1) = "*" Then
            TblFinal(ColonneMotif, Ligne1) = Val_a_InclureDsMotif
            Drapeau = True
            Exit For
        End If
    Next Ligne2
    
    If Drapeau Then
        Drapeau = False
        Exit For
    End If
Next Ligne1
End Sub

Public Function Nz(Valeur As Variant, Remplacement As String) As Variant
'Cette fonction est l'équivalent du Nz d'Access
Nz = IIf(Est_null(Valeur, , , False), Remplacement, Valeur)
End Function

Public Function Est_null(Objet As Variant, Optional Libelle As String = "", Optional Genre As Boolean = False, _
Optional Verbose As Boolean = False) As Boolean
' Cette fonction vérifie qu'une valeur n'est pas nulle
' Genre permet d'indiquer si on doit afficher en cas d'erreur "une" (True)
' ou "un" (False) dans la fenêtre "Veuillez en choisir ou en saisir un"
' Verbose sert à afficher ou non un message d'avertissement
'
'
' Paramètres : Objet : Variant
'              Libelle : String (optionnel)
'              Genre : String (optionnel défaut = False)
'              Val : String (optionnel)
'              Verbose : Boolean (optionnel défaut = False)
'
' Valeur de retour : Boolean

Dim Valeur As String

If IsObject(Objet) Then
    Valeur = IIf(IsNull(Objet.Value), "", Objet.Value)
ElseIf Not IsNull(Objet) Then
    Valeur = Objet
Else
    Valeur = vbNullString
End If

If Len(Trim(Valeur)) = 0 Then
    If Verbose Then
        MsgBox Libelle & " est obligatoire." & vbCrLf & "Veuillez en choisir" & _
        " ou en saisir un" & IIf(Genre = True, "e", "") & " s'il vous plaît", _
        vbCritical, Libelle & " manque."
        If IsObject(Objet) Then
            Select Case TypeName(Objet)
                Case "TextBox"
                    Objet.SetFocus
                Case "Range"
                    Objet.Select
            End Select
        End If
    End If
    Est_null = True
End If
End Function

Private Function ConcateneLigne(LigneCible As Integer, Optional QuelTableau As String = "TblFinal", Optional ColonneCible As Byte, _
Optional ValRemplacement As Variant) As String
'Cette fonction concatène les valeurs contenues dans les colonnes de la ligne LigneCible du tableau QuelTableau
'et renvoie cette concaténation

'Si ValRemplacement est renseignée, elle remplace la valeur de la case de la colonne ColonneCible par celle-ci

Dim Colonne As Byte, Tableau As Variant

Tableau = IIf(QuelTableau = "TblFinal", TblFinal, TableauATrier)

If IsMissing(ValRemplacement) Then ValRemplacement = vbNullString 'Lorsque cette variable n'est pas renseignée

For Colonne = 0 To NbreColonnes
    ConcateneLigne = ConcateneLigne & IIf(Len(ValRemplacement) > 0 And Colonne = ColonneCible, FormatePourMotif(ValRemplacement), _
    FormatePourMotif(Nz(Tableau(Colonne, LigneCible), vbNullString)))
Next Colonne
End Function

Private Sub CombleTblFinal(Ligne_a_Combler As Integer)
'Cette procédure comble tous les "*" restant dans la ligne Ligne_a_Combler du tableau TblFinal
Dim Ligne As Integer, Motif As String, Colonne As Byte
Dim LigneConcatenee As String
'- On construit le motif de Ligne_a_Combler
'- On parcourt TableauATrier et pour chaque ligne on construit la concaténation
'- Si on match alors :
'           - On remplace chaque colonne contenant un "*" par la valeur correspondante
'           - On "désactive la ligne de TableauATrier en rendant nul le contenu de ses cellules

Motif = ConcateneLigne(Ligne_a_Combler)

For Ligne = 0 To NbreLignes
    LigneConcatenee = ConcateneLigne(Ligne, "TableauATrier")
    
    If LigneConcatenee Like Motif And Not IsNull(TableauATrier(0, Ligne)) Then
        For Colonne = 0 To NbreColonnes
            TblFinal(Colonne, Ligne_a_Combler) = TableauATrier(Colonne, Ligne)
            TableauATrier(Colonne, Ligne) = Null
        Next Colonne
        'La procédure a remplit son bon office => On la quitte
        Exit Sub
    End If
Next Ligne
End Sub

Public Function Format_Longueur(Chaine As String, Caract As String, Optional Longueur As Integer = 0, Optional Sens = "G") As String
Dim Tampon As String
'Cette fonction permet d'ajouter avant ou après Chaine, en fonction de Sens, le caractère Caract afin que la chaine retournée fasse Longueur de long
If Longueur = 0 Or Len(Chaine) > Longueur Then
    Format_Longueur = Chaine
    Exit Function
End If

Tampon = String(Longueur - Len(Chaine), Caract)

Format_Longueur = IIf(Sens = "G", Tampon & Chaine, Chaine & Tampon)

End Function

Private Function FormatePourMotif(ByVal Valeur As Variant) As String
'Comme le motif est constitué de *, ce qui signifie n'importe quel nombre de caractères,
'On se retrouve, pour les nombres, avec des tris inexacts.
'Exemple : on doit trier 30 et 3 par ordre croissant sur deux colonnes.
'- Le motif élaboré est 3* car c'est 3 la valeur la plus petite
'Mais, dans la comparaison du motif avec les lignes, la première testée est 30
'- On se retrouve donc avec un match positif, car 30 matche avec "3*" ce qui n'est pas le résultat attendu

'Pour remédier à celà :
'On force un formatage des nombres sur PrecisionDecimal.

'Pour les dates, afin d'être certain de ne pas avoir de soucis de format de date français, anglo-saxons ou autres,
'on les caste en Double et on les formate sur PrecisionDecimal

'Pour les Booléen, on les caste en Entier

Dim Regle As New RegExp

If TypeName(Valeur) = "Boolean" Then
    FormatePourMotif = IIf(Valeur, -1, 0)
ElseIf IsNumeric(Valeur) Or IsDate(Valeur) Then
    Valeur = CDbl(Valeur)
    
    Valeur = Replace(CStr(Valeur), ",", ".")
    'Replace(CStr(Valeur), ",", ".") pour que le séparateur de décimales soit formaté à l'anglo-saxonne
    With Regle
        .Pattern = "^\d+$"
        Valeur = Valeur & IIf(.Test(Valeur), ".", vbNullString)
        'Valeur = Valeur & IIf(.Test(Valeur), ".", vbNullString)
        'Le motif de l'expression rationnelle regarde s'il n'y a que des chiffres dans Valeur
        '- Si c'est le cas, on ajoute un séparateur décimal, sinon, il y en a déjà et on a pas besoin de l'ajouter.
    End With
    FormatePourMotif = Mid(Valeur, 1, InStr(1, Valeur, ".")) & _
    Format_Longueur(Mid(Valeur, InStr(1, Valeur, ".") + 1), "0", PrecisionDecimal, "D")
    'On récupère les décimales en formatant sur PrecisionDecimal
Else
    FormatePourMotif = Valeur
End If
End Function

Public Sub ReinitTblColonnesTri()
'Cette procédure supprime tous les critère de choix de colonne et de sens de tri
ReDim TblColonnesTri(1, 0)
End Sub

Conclusion :


Public Sub TriTableau()
Dim Tableau As Variant
Dim MonTrieur As New TrieurTableau, Ligne As Variant
Dim Ligne1 As Byte, Ligne2 As Byte

'Une dimension
ReDim Tableau(3)
Tableau(0) = 3: Tableau(1) = 1: Tableau(2) = 2: Tableau(3) = 0

With MonTrieur
.AttribueTableau = Tableau
.AjouteColonneTri 0, "DESC"
Tableau = .TableauTrie
End With

For Each Ligne In Tableau
Debug.Print Ligne
Next Ligne

'Deux dimensions
ReDim Tableau(3, 7)

Tableau(0, 0) = 10: Tableau(1, 0) = "A": Tableau(2, 0) = #3/25/1970#: Tableau(3, 0) = True
Tableau(0, 1) = 30: Tableau(1, 1) = "C": Tableau(2, 1) = #3/26/1970#: Tableau(3, 1) = True
Tableau(0, 2) = 20: Tableau(1, 2) = "B": Tableau(2, 2) = #3/27/1970#: Tableau(3, 2) = True
Tableau(0, 3) = 40: Tableau(1, 3) = "D": Tableau(2, 3) = #3/28/1970#: Tableau(3, 3) = True
Tableau(0, 4) = 1: Tableau(1, 4) = "A": Tableau(2, 4) = #3/29/1970#: Tableau(3, 4) = False
Tableau(0, 5) = 3: Tableau(1, 5) = "C": Tableau(2, 5) = #3/30/1970#: Tableau(3, 5) = False
Tableau(0, 6) = 2: Tableau(1, 6) = "B": Tableau(2, 6) = #3/31/1970#: Tableau(3, 6) = False
Tableau(0, 7) = 4: Tableau(1, 7) = "D": Tableau(2, 7) = #4/1/1970#: Tableau(3, 7) = False

With MonTrieur
.AttribueTableau = Tableau
'On supprime la colonne de tri qui a servi pour le test de tri
'du tableau à une dimension
'Si on ne fait pas cela, le premier tri se fera sur cette colonne, chose que l'on ne veut pas
'On pourrait aussi modifier celle-ci en saisissant
'.ModifieColonneTri 0, 1, "DESC"
.SupprimeColonneTri 0
.AjouteColonneTri 1, "DESC"
.AjouteColonneTri 3, "DESC"
.AjouteColonneTri 4
.ModifieColonneTri 3, 0, "ASC"
.SupprimeColonneTri 4
Tableau = .TableauTrie
End With

'On doit se retrouver avec le tableau trié comme suit
'4 D #4/1/1970# False
'40 D #3/28/1970# True
'3 C #3/30/1970# False
'30 C #3/26/1970# True
'2 B #3/31/1970# False
'20 B #3/27/1970# True
'1 A #3/29/1970# False
'10 A #3/25/1970# True

For Ligne1 = 0 To 7
For Ligne2 = 0 To 3
Debug.Print Tableau(Ligne2, Ligne1)
Next Ligne2
Next Ligne1

'Suite au bug sur le tri des valeurs numériques
'On fait des tests plus poussés

Tableau(0, 0) = 5: Tableau(1, 0) = "A": Tableau(2, 0) = #3/25/1970#: Tableau(3, 0) = True
Tableau(0, 1) = 3.14159: Tableau(1, 1) = "C": Tableau(2, 1) = #3/26/1970#: Tableau(3, 1) = True
Tableau(0, 2) = 3: Tableau(1, 2) = "B": Tableau(2, 2) = #3/1/1970#: Tableau(3, 2) = True
Tableau(0, 3) = 40: Tableau(1, 3) = "D": Tableau(2, 3) = #1/3/1970#: Tableau(3, 3) = True
Tableau(0, 4) = 1: Tableau(1, 4) = "A": Tableau(2, 4) = #3/30/1970 11:59:00 PM#: Tableau(3, 4) = False
Tableau(0, 5) = 3.000001: Tableau(1, 5) = "C": Tableau(2, 5) = #3/30/1970 12:01:00 AM#: Tableau(3, 5) = False
Tableau(0, 6) = 3.1416: Tableau(1, 6) = "B": Tableau(2, 6) = #3/31/1970 8:00:00 AM#: Tableau(3, 6) = False
Tableau(0, 7) = 4: Tableau(1, 7) = "D": Tableau(2, 7) = #3/31/1970 8:00:00 PM#: Tableau(3, 7) = True

With MonTrieur
.ReinitTblColonnesTri 'On supprime tous les précédents critères de tri
.AttribueTableau = Tableau
.NbreDecimales = 40 'On veut une précision des décimales pour les nombres de 40 au lieu des 20 définis par défaut
'Tri sur les nombres
.AjouteColonneTri 0
Tableau = .TableauTrie
End With

'Tri sur les nombres :
'On doit se retrouver avec le tableau trié comme suit
'1 A #3/30/1970 11:59:00 PM# False
'3 B #3/1/1970# True
'3.000001 C #3/30/1970 12:01:00 AM# False
'3.14159 C #3/26/1970# True
'3.1416 B #3/31/1970 8:00:00 AM# False
'4 D #3/31/1970 8:00:00 PM# True
'5 A #3/25/1970# True
'40 D #1/3/1970# True

For Ligne1 = 0 To 7
For Ligne2 = 0 To 3
Debug.Print Tableau(Ligne2, Ligne1)
Next Ligne2
Next Ligne1

'Tri sur les dates
With MonTrieur
.AttribueTableau = Tableau
.ModifieColonneTri 0, 2
Tableau = .TableauTrie
End With

For Ligne1 = 0 To 7
For Ligne2 = 0 To 3
Debug.Print Tableau(Ligne2, Ligne1)
Next Ligne2
Next Ligne1

'Tri sur les dates
'On doit se retrouver avec le tableau trié comme suit
'40 D #1/3/1970# True
'3 B #3/1/1970# True
'5 A #3/25/1970# True
'3.14159 C #3/26/1970# True
'3.000001 C #3/30/1970 12:01:00 AM# False
'1 A #3/30/1970 11:59:00 PM# False
'3.1416 B #3/31/1970 8:00:00 AM# False
'4 D #3/31/1970 8:00:00 PM# True

End Sub

A voir également

Ajouter un commentaire

Commentaires

Messages postés
9
Date d'inscription
vendredi 25 novembre 2005
Statut
Membre
Dernière intervention
19 août 2013

Bonjour CGSI3

Je te remercie pour les liens que tu as indiqué.
En se rendant sur http://www.dailly.info/Avant-propos, on a tout un article détaillant les différents algorithmes de tri.

Après étude de ce dernier, je tenterai d'implémenter celui qui me semble le plus judicieux pour accélérer le tri de cette classe, et ne manquerai pas de t'en informer.

Bonne journée

8Tnerolf8
Messages postés
416
Date d'inscription
vendredi 22 février 2008
Statut
Membre
Dernière intervention
7 janvier 2018
1
Bonsoir 8Tnerolf8,
Voici pour INFO, trouvé sur le net, un petit tableau permetant de comprendre les différences de rapidité de chaque tri,
http://www.dailly.info/Comparaisons-de-performances

les algorithmes de tri étant détaillé ici (a traduire dans notre langage)
http://www.dailly.info/-030-Algorithmes-de-Tri-
Messages postés
9
Date d'inscription
vendredi 25 novembre 2005
Statut
Membre
Dernière intervention
19 août 2013

Bonsoir CGSI3

- Si je n'ai pas utilisé une procédure du genre QuickSort, c'est tout simplement parce que je ne savais pas qu'elle existait.
Aurais-tu, s'il te plaît, des informations pour m'indiquer où la trouver et l'utiliser, sachant que je développe en VBA ?

- J'ai inclus deux IF dans ma procédure, une par type de tri, afin d'effectuer le bon tri de suite, à la volée.
Effectivement, ta suggestion de ne faire appel qu'à une sorte de tri et d'inverser le tableau ensuite, si besoin est, est envisageable, et, à l'occasion, j'implémenterai cette optimisation.

En te remerciant d'avoir pris la peine d'étudier ma classe d'objets, je ne manquerai pas de te tenir informé lorsque j'aurai adapté cette dernière comme tu l'as suggéré.

8Tnerolf8
Messages postés
416
Date d'inscription
vendredi 22 février 2008
Statut
Membre
Dernière intervention
7 janvier 2018
1
Bonsoir 8Tnerolf8,
Merci pour cette petite source, Je la lis rapidement ce soir et
je me suis surtout intéressé a ta procedure de tri

Voici 2 questions et des remarques:
- Pourquoi tu n'utilise pas une procédure de tri + rapide du genre QuickSort?
(ainsi ta source ne permettra pas de gérer de grande listes, le tri va s'éterniser)

- Une instruction IF dans une imbrication de 2 boucle FOR dois ralentir cette procedure de tri.
Pourquoi ne pas inverser ta selection a la fin du traitement selon le mode de tri voulu (trier sur le mode croissant et l'inverser si on le veux décroissant par exemple) ?

Remarque:
- 2 options de tri sont présente dans VB6 (je ne sais pas si elles le sont également en Vb.Net)
Option Compare Binary 'A < B < E < Z < a < b < e < z < À < Ê < Ø < à < ê < ø
Option Compare Text '(A=a) < ( À=à) < (B=b) < (E=e) < (Ê=ê) < (Z=z) < (Ø=ø)

- En Vb.Net il existe Linq qui permet je pense de faire le même genre de chose, mais je n'ai pas aprofondis toutes ses possibilités.

Cordialement
CGSI3
Messages postés
9
Date d'inscription
vendredi 25 novembre 2005
Statut
Membre
Dernière intervention
19 août 2013

Le bug sur le tri des valeurs numériques a été levé et le code de la classe d'objet mis à jour.

Vous trouverez en conclusion la procédure de recette portant sur un tri de nombres et un autre sur un tri de dates.
Afficher les 9 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.