Tri alphabétique

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 792 fois - Téléchargée 34 fois

Contenu du snippet

Cette fonction effectue le tri d'un tableau de chaines de caractéres

Source / Exemple :


Option Explicit

'**********************************************************************************
'     FONCTION DE TRIE ALPHABETIQUE D'UN TABLEAU DE CHAINES DE CARACTERES         *
'     -------------------------------------------------------------------         *
'                                                                                 *
'       Auteur : S. Alexandre                                                     *
'       Adresse : Paris (France)                                                  *
'                                                                                 *
'       Date de création : 24/06/2003                                             *
'        Modifier : 08/02/2004                                                             *
'       Language : Visual Basic 6                                                 *
'                                                                                 *
'      ------------------------------------------------------------------         *
'                                                                                 *
'       Paramétre d'entrée :                                                      *
'               tab_trie() = tableau a trier                                      *
'                                                                                 *
'       Paramétre en sortie :                                                     *
'               Sorted_TabString = true <le trier c'est effectuer sans            *
'                        probléme. Le tableau a été modifier en conséquence>      *
'               Sorted_TabString = false <Une erreur c'est produite. le           *
'                        tableau n'a pas été modifier.>                           *
'                                                                                 *
'**********************************************************************************
Public Function Sorted_TabString(tab_trie() As String) As Boolean
    Dim l() As String
    Dim s1 As String, s2 As String
    Dim a As Long, id As Long, c As Long, d As Long
    On Error GoTo err_quit
    ReDim l(0)
    l(0) = tab_trie(0)
    For a = 1 To UBound(tab_trie(), 1)
        id = 0
        c = 1
        Do While id <= UBound(l(), 1)
            s1 = LCase(Mid(Trim(tab_trie(a)), c, 1))
            s2 = LCase(Mid(Trim(l(id)), c, 1))
            If s1 < s2 Then
                Exit Do
            ElseIf s1 = s2 Then
                c = c + 1
                If c > Len(Trim(tab_trie(a))) + 1 Or c > Len(Trim(l(id))) + 1 Then
                       Exit Do
                end if
            Else
                c = 1
                id = id + 1
            End If
        Loop
        ReDim Preserve l(a)
        For d = UBound(l(), 1) To id + 1 Step -1
            l(d) = l(d - 1)
        Next d
        l(id) = tab_trie(a)
    Next a
    tab_trie() = l()
    Sorted_TabString = True
    Exit Function
err_quit:
    Sorted_TabString = False
End Function

A voir également

Ajouter un commentaire

Commentaires

sylric
Messages postés
91
Date d'inscription
mardi 21 janvier 2003
Statut
Membre
Dernière intervention
22 août 2003
-
ça marche pas terrible, ça retourne toujours faux
Et il y a d'autres erreurs,
quand tu fais
Dim s1, s2 As String
Dim a, id, c, d As Long
S2 est déclaré comme string et s1 comme Variant, de même, a, id, c sont des variant et d est long.
Pour faire bien :
Dim S1 As String, s2 As String
Dim a As String, id As String, c As String, d As String

Autre erreur, comment tu fais avec un tableau dont le premier indice n'est pas 0 ? Tu n'a pas le droit de le trié ?

En attendant que ça marche...
cs_BFR
Messages postés
88
Date d'inscription
mardi 30 juillet 2002
Statut
Membre
Dernière intervention
1 mars 2008
-
on peut toujours faire plus simple il s'agit du tri à bulle adapté en trie alphabétique je m'en sert pour trier les dossier il faut simplement remplir un tableau avec les éléments à trier .Il existe des algo de trie plus rapide mais cela suffit pour quelques dizaines d'élements
A++

'-Trier (à bulle)les dossiers d'un tableau dans l'ordre alphabétique
'-Déclarations
Dim lgFor1 As Long
Dim lgFor2 As Long
Dim lgMin As Long
Dim MemoTmp As String

'-Init:
lgMin = LBound(Tableau)


'-Parcourt l'ensemble des éléments du tableau
For lgFor1 = UBound(Tableau) - 1 To lgMin Step -1

'-Parcourt l'ensemble des éléments non triés du tableau
For lgFor2 = lgMin + 1 To lgFor1

'-Comparaison du code numérique du 1er caractère de la chaine
If Asc(Left$(Tableau(lgFor2 - 1), 1)) > Asc(Left$(Tableau(lgFor2), 1)) Then

'-Echange de place entre deux éléments
'-Mémorisation
MemoTmp = Tableau(lgFor2 - 1)
'-Echange
Tableau(lgFor2 - 1) = Tableau(lgFor2)
'-Affectation élement mémoriser
Tableau(lgFor2) = MemoTmp
End If

Next lgFor2

Next lgFor1
OverBillion
Messages postés
15
Date d'inscription
mercredi 24 septembre 2003
Statut
Membre
Dernière intervention
14 mars 2008
-
ouais...c cool tout ces algo de tri..ca me rappelle le lycée...

mais bon VB est plus fort que ca

utilisez plutot les listes....

ben oui! tu fous par une boucle for tout un tabelau de chaine dans une liste..

genre

for x = 1 to NbrIndice
list additem(tablo(x))
next x

ET! :::: la liste doit avoir sa propriété "sort" à true
genre: list.sort = true
pis a la fin...vous récupérez les éléments de la liste en ordre indexé
pis cest trié.....

haha! ben plus facile non?

a+ les mec!
bubble44
Messages postés
200
Date d'inscription
lundi 10 mars 2003
Statut
Membre
Dernière intervention
3 août 2004
-
Oui, l'idee de OverBillion est géniale.
Dans votre listbox c'est la propriéte "Sorted" a mettre a true.
Et apparement cette option ne se met qu'en design time, c'est a dire que l'on ne peut pas la changer en cours de programme (list.sort = true, est pas autorisé donc).

Sinon la syntaxe de additem est :

List1.AddItem ("b")
List1.AddItem ("a")
List1.AddItem ("z")
List1.AddItem ("e")
List1.AddItem ("h")
List1.AddItem ("c")

voila ce rajout de précisions vous fera gagner qqs mn, je trouvais pas le "sort".

a+ les filles !
=)))))
bubble44
Messages postés
200
Date d'inscription
lundi 10 mars 2003
Statut
Membre
Dernière intervention
3 août 2004
-
Finallement j'ai besoin aussi d'un truc par nombre et la listbox ne fait pas l'affaire, et c'est quand meme pas tres elegeant de prendre un objet windows pour faire des tris donc voici du 100 % code :

Option Explicit

Private Sub Command1_Click()

Dim aa(5) As String

aa(0) = "desintegrator"
aa(1) = "dunbar"
aa(2) = "fpoullet"
aa(3) = "fsalamo"
aa(4) = "apachus"
aa(5) = "bubble44"

Call BubbleSortAlpha(aa)

aa(0) = "0"
aa(1) = "1"
aa(2) = "4"
aa(3) = "11"
aa(4) = "2"
aa(5) = "10"

Call BubbleSortNumber(aa)

End Sub

Public Sub BubbleSortAlpha(arr As Variant)
Dim first As Long
Dim last As Long
Dim i As Long
Dim noswap As Boolean
Dim v As Variant

first = LBound(arr)
last = UBound(arr)

last = last - 1
Do While first <= last
noswap = True
For i = first To last
If arr(i) > arr(i + 1) Then
v = arr(i)
arr(i) = arr(i + 1)
arr(i + 1) = v
noswap = False
End If
Next i
last = last - 1
If noswap Then Exit Do
Loop
End Sub

Public Sub BubbleSortNumber(arr As Variant)
Dim first As Long
Dim last As Long
Dim i As Long
Dim noswap As Boolean
Dim v As Variant

first = LBound(arr)
last = UBound(arr)

last = last - 1
Do While first <= last
noswap = True
For i = first To last
If CInt(arr(i)) > CInt(arr(i + 1)) Then ' peut planter si pas integer à blinder donc ...
v = arr(i)
arr(i) = arr(i + 1)
arr(i + 1) = v
noswap = False
End If
Next i
last = last - 1
If noswap Then Exit Do
Loop
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.

Du même auteur (cs_alex314)