Tri rapide (QuickSort) en VBA
Il est parfois utile de trier une liste de chaînes de caractères en VBA. Euh… en fait, sur Access, ça ne sert pas tous les jours, puisqu’on stocke souvent les valeurs dans des tables, et qu’on a des requêtes graphiques ou SQL pour trier le tout ! 🙂
Mais ça n’est pas toujours le cas : vous pouvez avoir des données spécifiques à VBA, et vouloir les trier sans les stocker. Cet article donne l’une des approches possibles.
Principe
Voici donc un exemple de tri rapide (algorithme QuickSort). J’ai à peine adapté un bout de code provenant du livre « Ready-to-Run Visual Basic Algorithms » de Rod Stephens (l’adresse ici). Vous trouverez aussi des compléments sur la page Wikipédia Tri rapide, si vous voulez écrire votre propre version.
Le code
Recopiez ce qui suit dans un module standard de votre base de données :
|
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 |
' --- ' TRI ALPHABETIQUE D'UNE LISTE DE CHAINES ' DE CARACTERES A L'AIDE DE L'ALGORITHME ' QUICKSORT ' --- ' Code adapté du livre "Ready-to-Run ' Visual Basic Algorithms" de Rod Stephens : ' http://www.vb-helper.com/vba.htm ' ' Algorithme général : ' http://fr.wikipedia.org/wiki/Tri_rapide ' Sub QuickSort( _ list() As String, _ ByVal lngMin As Long, _ ByVal lngMax As Long) Dim strMidValue As String Dim lngHi As Long Dim lngLo As Long Dim lngIndex As Long ' S'il y a 0 ou 1 élément dans la liste, ' la sous-liste est déjà triée If lngMin >= lngMax Then Exit Sub ' Valeur de partionnement lngIndex = Int((lngMax - lngMin + 1) * Rnd + lngMin) strMidValue = list(lngIndex) ' Echanger les valeurs list(lngIndex) = list(lngMin) lngLo = lngMin lngHi = lngMax Do ' Chercher, à partir de lngHi, une valeur < strMidValue Do While list(lngHi) >= strMidValue lngHi = lngHi - 1 If lngHi <= lngLo Then Exit Do Loop If lngHi <= lngLo Then list(lngLo) = strMidValue Exit Do End If ' Echanger les valeurs lngLo et lngHi list(lngLo) = list(lngHi) ' Chercher à partir de lngLo une valeur >= strMidValue lngLo = lngLo + 1 Do While list(lngLo) < strMidValue lngLo = lngLo + 1 If lngLo >= lngHi Then Exit Do Loop If lngLo >= lngHi Then lngLo = lngHi list(lngHi) = strMidValue Exit Do End If ' Echanger les valeurs lngLo et lngHi list(lngHi) = list(lngLo) Loop ' Trier les 2 sous-listes QuickSort list, lngMin, lngLo - 1 QuickSort list, lngLo + 1, lngMax End Sub |
La procédure reçoit 3 paramètres :
- Le tableau de chaînes à trier.
- L’indice de départ pour le tri (en général : 1).
- L’indice de fin pour le tri (en général : le nombre d’éléments dans le tableau).
Tester
Et pour tester, recopiez aussi ceci :
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Sub TestQuickSort() Dim astrPersonnes(1 To 5) As String Dim intI As Integer ' Les personnes astrPersonnes(1) = "Steve" astrPersonnes(2) = "Bill" astrPersonnes(3) = "Bob" astrPersonnes(4) = "John" astrPersonnes(5) = "Michael" ' On trie la liste QuickSort astrPersonnes, 1, 5 ' On affiche For intI = 1 To 5 Debug.Print astrPersonnes(intI) Next End Sub |
Il vous suffit ensuite :
- De faire apparaître la fenêtre Exécution (
Ctrl+G). - De placer votre curseur dans le deuxième bout de code (entre
Sub TestQuickSort()etEnd Sub). - De cliquer sur l’icône Exécuter Sub/UserForm.
Vous devriez obtenir ceci dans la fenêtre Exécution :
Rendez-vous demain pour une application pratique du QuickSort…
