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 |
