Sujet que je n'ai trouvé abordé qu'une fois par Dude (même pas sûr
; suis tombé dessus naguère, mais maintenant, pas moyen de le retrouver) ; j'ai voulu généraliser un peu, et en particulier traiter la conservation ou non des doublons.On trouve également dans la bibliothèque Tools (module Strings) une fonction BubbleSortList, singulièrement lente (tri à bulle) pour de grands tableaux.
Ici, on utilise un tri fusion :
-- diviser le tableau en deux
-- trier chaque partie (récursivité)
-- imbriquer les deux parties triées : ajouter le plus petit des deux éléments suivants (un pour chaque partie).
Code : Tout sélectionner
'Tri rapide : séparer en deux, trier les parties, les imbriquer
'noDouble = true pour supprimer les doublons
'les indices commencent à 0
Function SortedList(list, noDouble As Boolean)
Dim ub%
ub = UBound(list)
If ub<1 Then
SortedList = list
Exit Function
End If
Dim ub1%, list1, list2
'Diviser la liste en deux
ub1 = ub\2
list1 = ListSegment(list,0,ub1)
list2 = ListSegment(list,ub1+1,ub)
'Trier les parties
list1 = SortedList(list1,noDouble)
list2 = SortedList(list2,noDouble)
'Les imbriquer
SortedList = SortedUnion(list1,list2,noDouble)
End Function
'************************************************************************
'Former une nouvelle liste en prenant à chaque fois le plus petit élément.
Function SortedUnion(list1, list2, noDouble As Boolean)
Dim i1%, ub1%, elem1, i2%, ub2%, elem2, i%, ub%, elem
ub1 = Ubound(list1)
ub2 = UBound(list2)
ub = ub1+ub2+1
Dim list(0 To ub)
'i1 = 0 : i2 = 0 : i = 0 'inutile
While i1<=ub1 And i2<=ub2
elem1 = list1(i1)
elem2 = list2(i2)
If noDouble And elem1=elem2 Then
list(i) = elem1
i1 = i1+1
i2 = i2+1
ElseIf elem2<elem1 Then '<--- ici pour changer le mode de tri
list(i) = elem2
i2 = i2+1
Else
list(i) = elem1
i1 = i1+1
End If
i = i+1
Wend
'Une des listes est épuisée : compléter avec les éléments restants de l'autre liste
If i2<=ub2 Then
For i2=i2 To ub2
list(i) = list2(i2)
i = i+1
Next i2
Else
For i1 =i1 To ub1
list(i) = list1(i1)
i = i+1
Next i1
End If
'Redimensionner si des doublons ont été éliminés
If i<=ub Then Redim Preserve list(0 To i-1)
SortedUnion = list
End Function
'**********************************************************
'Retourne la liste des éléments pour les indices de lb à ub
'org (0 par défaut) est la base de la nouvelle liste
Function ListSegment(list, lb%, ub%, Optional org%)
If IsMissing(org) Then org=0
'décalage des indices
Dim delta% : delta = lb-org
Dim list1(org To ub-delta), i%
For i = lb To ub
list1(i-delta) = list(i)
Next i
ListSegment = list1
End FunctionPour trier en ordre décroissant, il suffit de remplacer
Code : Tout sélectionner
ElseIf elem2<elem1 Then '<--- ici pour changer le mode de tri
Code : Tout sélectionner
ElseIf elem2>elem1 Then '<--- ici pour changer le mode de tri
