Soyez le premier à donner votre avis sur cette source.
Vue 19 193 fois - Téléchargée 673 fois
' ********************************** ' * 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
31 août 2004 à 23:42
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
25 janv. 2004 à 15:57
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
1 mai 2003 à 17:02
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.