Algo de tri à bulles : permet de trier un fichier texte de A à Z avec suppression des doublons :)
Source / Exemple :
'Auteur Gérôme GUILLEMIN 02/1999'Algorithme de tri avec + suppression de doublons
Public Sub main()
On Error GoTo er
Dim A() As String * 255
Dim c As Long 'Compteur
Open "zz.txt" For Input As #1 'On ouvre un fichier
Do Until EOF(1)
Line Input #1, b$
c = c + 1
Loop
Close #1
ReDim A(c)
Open "zz.txt" For Input As #1
For x = 1 To c
Input #1, A$(x)
Next
Close #1
' Tri bulle du tableau A$ par permutation
Const FAUX = 0, VRAI = Not FAUX
Max = UBound(A$)
Echange = VRAI ' Imposer un premier passage par le tableau.
While Echange ' Trier jusqu'
ce que tous les éléments soient échangés.
Echange = FAUX
' Comparer les lééments du tableau par paires.
Quand deux éléments
' sont échangés, imposer un nouveau passage en rendant Echange VRAI:
For I = 2 To Max '\ 2
If A$(I - 1) > A$(I) Then
Echange = VRAI
aa$ = A$(I - 1) 'ZZ
bb$ = A$(I) 'AA
A$(I - 1) = bb$
A$(I) = aa$
jmpt: 'Saut
'SWAP A$(I - 1), A$(I) 'commande QB bien pratique :))
End If
Next
Wend
Open "zz.txt" For Output As #1 'On écrase le fichier...
Close #1
Open "zz.txt" For Append As #1
For I = 1 To c
Ecrire$ = Trim$(A$(I))
Ecrire_moins_un$ = Trim$(A$(I - 1))
If Ecrire$ = Ecrire_moins_un$ Then GoTo jmp
'Traiter les doublons
If Ecrire$ = "" Then I = I + 1: GoTo jmp 'But : éliminer les chaines vides
Print #1, Ecrire$
jmp: 'Saut
Next I
Close #1
Beep
ReDim A(1) 'As String * 255
MsgBox ("Fin du traitement à bulle")
Exit Sub
er: 'Gestion des erreurs
Beep
If Err = 53 Then
MsgBox (Err.Description), , ("Erreur : fichier ZZ.txt introuvable !!!")
End If
End Sub
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.