CLASSER DES CHAINES PAR ORDRE ALPHABÉTIQUE.

'                          **********************************
'                          *    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