Tri alphabétique

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 848 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
Messages postés
2
Date d'inscription
mardi 13 avril 2004
Statut
Membre
Dernière intervention
20 octobre 2005

Merci pour ce code qui n'a pas besoin d'interface (ListBox)

J'ai ajouté une amélioration qui ne manque pas d'intérêt de par sa simplicité
Voici la fonction intégrée dans un de mes programmes (d'où les changement de noms):

Public Function Tri_ALPHA(Tab_String() As String, Ascendant As Boolean) 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
Dim Condition As Boolean
On Error GoTo err_quit
ReDim l(0)
l(0) = Tab_String(0)
For a = 1 To UBound(Tab_String(), 1)
id = 0
c = 1
Do While id <= UBound(l(), 1)
s1 = LCase(Mid(Trim(Tab_String(a)), c, 1))
s2 = LCase(Mid(Trim(l(id)), c, 1))
If Ascendant Then
Condition = (s1 < s2)
Else
Condition = (s1 > s2)
End If
If Condition Then
Exit Do
ElseIf s1 = s2 Then
c = c + 1
If c > Len(Trim(Tab_String(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_String(a)
Next a
Tab_String() = l()
Tri_ALPHA = True
Exit Function
err_quit:
Tri_ALPHA = False
End Function
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
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 !
=)))))
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!
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
Afficher les 6 commentaires

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)