Discussion :

[ProgElecT]

Salut

2 fonctions pour trier des mots/phrases.

Si vous n'avez à trier qu'une variable tableau, seule la fonction TrierTbl vous est utile.
Si vous voulez trier une variable simple il vous faut la fonction Trier mais aussi la fonction TrierTbl.

La fonction pour une variable tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function TrierTbl(TblDonn)
Dim Cpt1, Cpt2, CountTbl
Dim MotIdxH, MotIdxB
Dim MeTbl
On Error Resume Next
If UBound(TblDonn) = 0 Then TrierTbl = TblDonn: Exit Function
If Err Then TrierTbl = vbEmpty : Exit Function
MeTbl = TblDonn
CountTbl = UBound(MeTbl)
For Cpt1 = 0 To CountTbl
    For Cpt2 = CountTbl To 1 Step -1
        MotIdxB = MeTbl(Cpt2 - 1)
        MotIdxH = MeTbl(Cpt2)
        If UCase(MotIdxB) > UCase(MotIdxH) Then
            MeTbl(Cpt2) = MotIdxB
            MeTbl(Cpt2 - 1) = MotIdxH
        End If
    Next
Next
TrierTbl = MeTbl
End Function

La fonction pour une variable simple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function Trier(Donn, InSeparateur, OutSeparateur)
Dim Tableau
If Donn = "" Then Trier = "": Exit Function
Tableau = Split(Donn, InSeparateur)
Tableau = TrierTbl(Tableau)
If UBound(Tableau) = 0 Then Trier = Donn: Exit Function
Trier = Join(Tableau, OutSeparateur) 'retour du tableau trié
End Function

Le code de démonstration avec ces commentaires

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
'********************************************** partie principale ******************************************
Dim MsG, VarDemo, MeDonn ' variables utiles à la démo
'Initialisation pour la démo
MeDonn = "premier,deuxième,troisième,quatrième,cinquième,Sixième,septième,huitième,neuvième,Dixième"
 
'------------------------ Exemples avec une variable simple ----------------------
MsG = "Variable contenant 10 éléments:" & vbNewLine & vbNewLine
VarDemo = MeDonn
MsgBox MsG & Trier(VarDemo, ",",vbNewLine), vbInformation, "Tri variable simple"
'						............................................
MsG = "Variable ne contenant qu'un élément:" & vbNewLine & vbNewLine
VarDemo = "premier"
MsgBox MsG & Trier(VarDemo, ",",chr(44)), vbInformation, "Tri variable simple"
'						............................................
MsG = "Variable ne contenant aucun élément" & vbNewLine & vbNewLine
VarDemo = ""
MsgBox MsG & Trier(VarDemo, ",",chr(44)), vbInformation, "Tri variable simple"
'------------------------ Exemples avec une variable tableau -----------------------------------------------
Dim VarTbl
VarTbl = Split(MeDonn, ",") 'création d'un tableau de données provenant de la variable définit plus haut
 
MsG = "Variable tableau valide contenant des éléments:" & vbNewLine & vbNewLine
VarTbl = TrierTbl(VarTbl) ' tri du tableau
VarDemo = Join(VarTbl, vbNewLine) 'compilation du tableau dans une variable simple pour permettre l'affichage
MsgBox MsG & VarDemo, vbInformation, "Tri tableau"
'						............................................
MsG = "Variable tableau valide ne contenant qu'un élément:" & vbNewLine & vbNewLine
Erase VarTbl: Redim VarTbl(1): VarTbl(0)="premier"
VarTbl = TrierTbl(VarTbl) ' tri du tableau
VarDemo = Join(VarTbl, vbNewLine) 'compilation du tableau dans une variable simple pour permettre l'affichage
MsgBox MsG & VarDemo, vbInformation, "Tri tableau"
'						............................................
MsG = "Variable tableau non valide:" & vbNewLine & vbNewLine
Erase VarTbl
VarTbl = TrierTbl(VarTbl) ' tri du tableau
VarDemo = Join(VarTbl, vbNewLine) 'compilation du tableau dans une variable simple pour permettre l'affichage
MsgBox MsG & VarDemo, vbInformation, "Tri tableau"
 
'********************************************* Fin partie principale ***************************************
 
'//////////////////////////////////// les fonctions \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Function Trier(Donn, InSeparateur, OutSeparateur)
'Donn = données soumis au tri
'InSeparateur = caractère séparateur des données soumis pour le tri
'OutSeparateur = caractère séparateur souhaité en retour du tri
Dim Tableau
 
'variable vide, donc pas de tri à faire
If Donn = "" Then Trier = "": Exit Function
'Création d'un tableau à l'aide du séparateur InSeparateur
Tableau = Split(Donn, InSeparateur)
'Utilise la fonction de tri effectif
Tableau = TrierTbl(Tableau)
'la variable soumis ne contenait qu'un élément
If UBound(Tableau) = 0 Then Trier = Donn: Exit Function
'concaténer les éléments du tableau trié
Trier = Join(Tableau, OutSeparateur) 'retour du tableau trié
End Function
'---------------------------------------------------------------
Function TrierTbl(TblDonn)
Dim Cpt1, Cpt2, CountTbl
Dim MotIdxH, MotIdxB
Dim MeTbl
 
'utile si le tableau soumis n'est pas valide (aucun indice) UBound(TblDonn) provocant une erreur
On Error Resume Next
If UBound(TblDonn) = 0 Then TrierTbl = TblDonn: Exit Function
If Err Then TrierTbl = vbEmpty : Exit Function ' cas du tableau soumis non valide
 
MeTbl = TblDonn
CountTbl = UBound(MeTbl)'nombre d'indices du tableau
'double boucle pour le tri effectif
For Cpt1 = 0 To CountTbl
    For Cpt2 = CountTbl To 1 Step -1
        MotIdxB = MeTbl(Cpt2 - 1)
        MotIdxH = MeTbl(Cpt2)
        If UCase(MotIdxB) > UCase(MotIdxH) Then
            MeTbl(Cpt2) = MotIdxB
            MeTbl(Cpt2 - 1) = MotIdxH
        End If
    Next
Next
 
TrierTbl = MeTbl 'retour du tableau trié
End Function
'//////////////////////////////////// Fin des fonctions \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Ces fonctions ne sont pas d'une très grande rapidité, pour utilisation dans un programme écrit en VBScript cela n'est pas des plus pénalisant.

[hackoofr]

et pour la contribution
un autre code avec le tri à bulles

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
Dim arrValue,i,inputstring,MeDonn,Titre,iLen
Dim aChars()
Titre = "Tri a bulles"
arrValue = Array(12,24,51,24,15,35,1000000,15,65,418,0,-5,842,-540,-65,75,100,45854,10000)
MsgBox Join(BubbleSort(arrValue),","),64,Titre
'*********************************************************************************
inputString = "poiuytrezamlkjhgfdsqnbvcxwZXSDEQARTYUIOPMGHJKLMWXCVBN"
iLen = Len(inputString)-1
ReDim aChars(iLen)
For i = 0 to iLen
    aChars(i) = Mid(inputString, i + 1,1)
Next
MsgBox Join(BubbleSort(aChars),","),64,Titre
'*********************************************************************************
inputstring = "Bonjour"
iLen = Len(inputString)-1
ReDim aChars(iLen)
For i = 0 to iLen
    aChars(i) = Mid(inputString, i + 1,1)
Next
MsgBox Join(BubbleSort(aChars),""),64,Titre
'*********************************************************************************
MeDonn = Array("premier","deuxième","troisième","quatrième","cinquième","Sixième","septième","huitième","neuvième","Dixième")
MsgBox Join(BubbleSort(MeDonn),","),64,Titre
'*********************************************************************************
Function BubbleSort(arrInt)
    Dim i,j,temp
    for i = UBound(arrInt) - 1 To 0 Step -1
        for j= 0 to i
            if arrInt(j)>arrInt(j+1) then
                temp = arrInt(j+1)
                arrInt(j+1) = arrInt(j)
                arrInt(j) = temp
            end if
        next
    next 
    BubbleSort = arrInt
End function
'*********************************************************************************

[ProgElecT]

Salut hackoofr

Avec du retard, le pourquoi j'ai proposé cette contribution (que je n'ai sut trouver sur DVP).

Je précise bien que ma proposition de tri porte sur des caractères, d’où le titre (alphabétique).
La petite différence porte sur le fait que j'avais besoin, pour des raisons personnelles, d'effectuer un tri non sensible à la CASSE, le tri ne tenant pas compte des majuscules, la condition passant par un Ucase If UCase(MotIdxB) > UCase(MotIdxH) Then.

Pour un Array égal à
"premier,deuxième,troisième,quatrième,cinquième,sixième,Septième,huitième,neuvième,Dixième"

la sortie avec le code que je propose est:
"cinquième,deuxième,Dixième,huitième,neuvième,premier,quatrième,Septième,sixième,troisième"

Avec le code que tu a posté cela donne:
"Dixième,Septième,cinquième,deuxième,huitième,neuvième,premier,quatrième,sixième,troisième"
Pour mon besoin cela ne conviendrait pas.