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 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ |
Partager