Classer des chaines par ordre alphabétique.

Soyez le premier à donner votre avis sur cette source.

Vue 17 289 fois - Téléchargée 616 fois

Description

Le code est très simple mais j'ai tenté de l'expliquer le plus possible en l'annotant de commentaires. On doit simplement créer un fichier d'où l'on extrait les chaines et une zone de liste nommée List1 pour l'affichage des chaines triées. Ensuite vous insérer le code dans le Form_load ou ailleurs, libre à vous.
Vous pouvez modifier la grandeur du tableau data (il peut dans mon code contenir 65556 chaines) pour libérer de la mémoire ou pour encore agrandir la capacité (pourquoi pas ?). Vous pouvez aussi prendre les chaines ailleurs que dans un fichier et les sortir autrepart que dans la liste.

Source / Exemple :


'                          **********************************
'                          *    Listing par Spectre 2001    *
'                          *       Classer des chaines      *
'                          *      par ordre alphabétique    *
'                          *     en suivant le code ASCII   *
'                          *(donc majuscule avant minuscule)*
'                          *     Pour toutes remarques,     *
'                          *  suggestions ou modifications: *
'                          *     spectre2001@ifrance.com    *
'                          *  Visitez www.wiziwig.fr.st !!  *
'                          * ------------------------------ *
'                          *  Outils : - fichier "c:\test"  *
'                          *           - Zone de liste List1*
'                          **********************************

'variable comptant le nombre de chaines à classer
Dim i As Integer
'déclare un tableau de valeurs qui va contenir les chaines de caractère non classées
'puis classées, sa contenance sera d'au maximun 65556 chaines (valeur à modifier)
Dim data(65556)
'variable qui va s'incrémenter au fur et à mesure des caractères en commun
Dim comcarac As Integer
'caractère déterminant la position de la chaine g (en commençant donc par le 1er)
Dim carac As String
'caractère déterminant des chaines gbis à comparer
Dim caractest As String
'code ascii caractère chaine g
Dim code As Integer
'code ascii caractère chaine gbis
Dim codetest As Integer
'chaines provisoires pour la permutation
Dim datasauv As String

'initialise concarac à 1 (valeur normale)
comcarac = 1
'ouvre le fichier contenant les chaines à classer
Open "c:\test.txt" For Input As #1
'pour pas que le nombre de chaines s'ajoute à chaque fois
i = 0
'boucle extrayant les chaines du fichier...
Do
'incrémente i
i = i + 1
'extrait ligne par ligne
Line Input #1, data(i)
'...jusqu'à ce que le fichier soit vide
Loop Until (EOF(1))

'Boucle classant les chaines (tri à bulle) s'exécutant autant de fois qu'il y a de chaines
'traite chaine par chaine
For g = 1 To i
    'boucle insérée, chaque chaine sera comparée à toutes les autres
    For gbis = 1 To i - 1
        'extrait le caractère de la chaine à classer, étiquette pour recommencer
        'les conditions
recommence: carac = Mid$(data(g), comcarac, 1)
        'si le caractère n'est pas rien
        If carac <> "" Then
                'le code du caractère
                code = Asc(carac)
            Else
                'sinon on dit un nombre impossible (car arret de la table à 256)
                'de façon à le mettre à la fin
                code = 257
        End If
        'on ne compare pas la chaine à elle-même
        If gbis <> g Then
            'extrait le caractère de la chaine à comparer
            caractest = Mid$(data(gbis), comcarac, 1)
             'même principe qu'en haut
            'si le caractère n'est pas rien
            If caractest <> "" Then
                'le code du caractère
                codetest = Asc(caractest)
            Else
                'sinon on dit un nombre impossible (car arret de la table à 256)
                'de façon à le mettre à la fin
                codetest = 257
            End If
            'si le code ascii de la chaine à classer est inférieur...
            If code < codetest Then
                '...alors on permute l'ordre des chaines
                datasauv = data(gbis)
                data(gbis) = data(g)
                data(g) = datasauv
            'si les deux caractères des chaines sont identiques alors...
            ElseIf code = codetest Then
                '...si on n'est pas arrivé au bout de la chaine à classer alors...
                If comcarac < Len(data(g)) Then
                    '...si on est arrivé au bout de la chaine à comparer avec
                    'tous les caractères des 2 chaines identiques...
                    If comcarac = Len(data(gbis)) Then
                        '...alors on s'en va sans toucher à l'ordre des chaines
                        GoTo saute
                    '...sinon...
                    Else
                    '...on recompare le caractère suivant des deux chaines
                    'on incrémente comcarac
                    comcarac = comcarac + 1
                    'et c'est reparti
                    GoTo recommence
                    End If
                '... mais si on est arrivé au bout de la chaine à classer sans
                'trouver de caractère différent...
                ElseIf comcarac = Len(data(g)) Then
                    '...si la chaine à classer et moins grande que celle à comparer...
                        If Len(data(g)) < Len(data(gbis)) Then
                        'on permute
                        datasauv = data(gbis)
                        data(gbis) = data(g)
                        data(g) = datasauv
                        End If
                End If
            End If
'étiquette pour sortir des conditions
saute:  End If
        'et hop on remet comcarac à 1 (valeur normale)
        comcarac = 1
    'et on tourne
    Next gbis
'et encore
Next g

'puis enfin on affiche les résultats dans une zone de liste grâce à une boucle
For r = 1 To i
    'on ajoute la chaine en cours dans le bon ordre
    List1.AddItem data(r)
'on tourne
Next r
'et puis tout est ok on ferme le fichier (on pourrait le faire plus tôt)
Close #1

Conclusion :


La routine trie donc des chaines de caractère par ordre alphabétique. Les chaines peuvent être de n'importe quelle taille et peuvent contenir tous les caractères ASCII. Elles sont triées par code ASCII, les majuscules apparaitront donc avant toutes les minuscules. La méthode utilisée est la méthode classique du tri à bulles, améliorée pour trier les chaines sur plusieurs caractères. Bref, ça marche très bien et c'est très efficace.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

ThunderPsycho
Messages postés
180
Date d'inscription
lundi 3 juin 2002
Statut
Membre
Dernière intervention
4 février 2007
-
Joli, efficace, et rapide... -> 9/10

J'ai trié un fichier texte comportant 800 entrées en qques secondes, celui-là marche bien mieux que le miens ;o)
J'avais aussi utilisé les codes ascii pour différencier les caractères, mais bon, je l'ai pas assez bien optimisé :o/

Sinon j'ai ajouté un textbox à la place de la liste afin que le contenu soir éditable et une fonction à la fin pour que les valeurs sorties soient uniques, cela n'apporte rien au prog mais c ce dont j'avais besoin donc je le met au cas ou, donc ds la boucle qui doit remplir la list :


For r = 1 To i

'La condition pour vérifier les valeurs doubles
If tempdata <> data(r) Then
result = result & data(r) & vbCrLf
tempdata = data(r)
End If

Next r

'Et l'affichage ds le textbox
TextBox1.Text = result
cs_liquide
Messages postés
1018
Date d'inscription
samedi 22 mars 2003
Statut
Membre
Dernière intervention
24 juin 2008
-
Bonjour,

C'est peut etre une grosse betise ce que je vais dire, mais j'aimerais bien une explication sur la methode de tri sur les "string" ,car , si j'ai pu comprendre le tri a bulle dans ce cas la, il s'agit de trier les "string" par ordre alphabetique en recherchant les caracteres Ascii 1 par 1. sur cela je me suis poser la question si je pouvais comparer directement tout le string par rapport a un autre et j'ai proceder de la sorte: Avec 3 Textbox et 1 command button

Private Sub Command9_Click()
If Text5.Text > Text6.Text Then Text7.Text = "True"
If Text5.Text < Text6.Text Then Text7.Text = "false"
If Text5.Text Text6.Text Then Text7.Text "egal"
End Sub
Il est clair que ca ne trie pas, en revanche et , bien entendu si mon raisonnement est bon, j'en ressort qu'il me donne le bon resultat sur tout le string, je n'ai pas necessairement besoin de comparer les Ascii

Alors voila, comme le tri a bulle est repandu, c'est qu'il doit etre la pour qqe chose !!!!!! j'en conclu dans cet exemple que c'est le "mode de tri" mais dans cet exemple meme, pk comparer Chaque Ascii alors que dans mon raisonnement , il n'est pas necessaire de le faire. Expliquez moi ou je foire dans mon raisonnement sur ce cas la SVP

liquide
Jefekoi
Messages postés
52
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
7 avril 2019
-
Bravo à toi j'en avais besoin , merci ;)

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.