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 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
| Option Explicit
'-------------------------------------------------------------------------------
Sub TableauDécalerElément(ByRef TabDonnées() As Variant, _
ByRef IndiceElément As Long, ByRef IndiceMini As Long, ByRef IndiceMaxi As Long)
'-------------------------------------------------------------------------------
Dim i As Long
If IndiceElément > (IndiceMaxi + IndiceMini) / 2 Then
For i = IndiceMaxi To IndiceElément Step -1 ' Décale vers le haut.
TabDonnées(i + 1) = TabDonnées(i)
Next i
IndiceMaxi = IndiceMaxi + 1 ' Nouvel indice maxi du tableau.
Else
For i = IndiceMini To IndiceElément ' Décale vers le bas.
TabDonnées(i - 1) = TabDonnées(i)
Next i
IndiceMini = IndiceMini - 1 ' Nouvel indice mini du tableau.
IndiceElément = IndiceElément - 1 ' Décale l'emplacement du nouvel élément.
End If
End Sub
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Sub TriRapide(ByRef TabDonnées() As Variant)
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Dim i As Long, n As Long, TabClassés() As Variant
ReDim TabClassés(-UBound(TabDonnées) - 1 To UBound(TabDonnées) + 1)
Dim TabDébut As Long, TabFin As Long
' Si moins de deux données à trier alors quitte.
If Abs(UBound(TabDonnées) - LBound(TabDonnées)) < 1 Then Exit Sub
' Classe les 2 premiers éléments par ordre croissant.
n = LBound(TabDonnées)
If TabDonnées(n + 1) > TabDonnées(n) Then i = 1
TabClassés(n) = TabDonnées(n + 1 - i)
TabClassés(n + 1) = TabDonnées(n + i)
TabDébut = LBound(TabDonnées): TabFin = LBound(TabDonnées) + 2 'Limites tableau classé
' Boucle sur les autres éléments à classer.
For n = 2 + LBound(TabDonnées) To UBound(TabDonnées)
' Recherche la position dans la liste des éléments classés.
i = TableauRecherchePosition(TabClassés(), TabDébut, TabFin, TabDonnées(n))
' Décale les éléments déjà classés pour faire une place.
Call TableauDécalerElément(TabClassés(), i, TabDébut, TabFin)
' Insère l'élément dans la liste des éléments classés.
TabClassés(i) = TabDonnées(n)
Next n
' Retourne le tableau classé :
n = LBound(TabDonnées)
For i = TabDébut To TabFin - 1
TabDonnées(n) = TabClassés(i):
n = n + 1
Next i
End Sub
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Function TableauRecherchePosition(ByRef TabDonnées() As Variant, ByVal Début As Long, _
ByVal Fin As Long, ByVal ValRecherchée As Variant) As Long
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Dim Milieu As Long
' Si nouvelle extrémité inférieure ou supérieure
If ValRecherchée <= TabDonnées(Début) Then TableauRecherchePosition = Début: Exit Function
If ValRecherchée >= TabDonnées(Fin - 1) Then TableauRecherchePosition = Fin: Exit Function
Do
Milieu = (Début + Fin) / 2 'Calcule le milieu du tableau borné par Début et Fin.
' Si l'élément à classer est compris entre Milieu et Milieu+1
If ValRecherchée >= TabDonnées(Milieu) And ValRecherchée <= TabDonnées(Milieu + 1) Then
TableauRecherchePosition = Milieu + 1 ' Retourne la position où insérer l'élément.
Exit Do ' Sort de la boucle
End If
If ValRecherchée > TabDonnées(Milieu) Then 'Compare l'élément avec le milieu
Début = Milieu + 1 'Nouvelle borne de début.
Else
Fin = Milieu - 1 'Nouvelle borne de fin.
End If
Loop
End Function
'-------------------------------------------------------------------------------
Sub ChargeLesDonnées()
'-------------------------------------------------------------------------------
Dim MonTableau() As Variant ' Déclare un tableau Variant dynamique.
Dim y As Long ' Indique la ligne à analyser.
Dim i As Long ' Indice du tableau.
y = 1
While Cells(y, 1) <> "" ' Boucle sur les lignes de la colonne A.
ReDim Preserve MonTableau(i) ' Redimensionne le tableau d'après l'indice.
MonTableau(i) = Cells(y, 1) ' Mémorise la valeur de la cellule.
i = i + 1 ' Incrémente l'indice du tableau.
y = y + 1 ' Passe à la ligne suivante.
Wend
Call TableauDécalerElément(MonTableau(), True) ' Appelle la fonction de tri du tableau.
For y = LBound(MonTableau) To UBound(MonTableau) ' Boucle sur les éléments.
Cells(y + 1, 2) = MonTableau(y) ' Affiche l'élément en B.
Next y
Application.ScreenUpdating = True
End Sub |
Partager