Sub QuickSortCroissantDecroissant()
Dim t() As Variant
Dim Flag As Boolean
Range(Cells(2, 3), Cells(Cells(1048576, 3).End(xlUp).Row, 3)).Clear
t = Range(Cells(2, 1), Cells(Cells(1048576, 1).End(xlUp).Row, 1))
tt = Timer()
IntroSort t, True: Flag = True ' Pour le tri croissant
'IntroSort t, False: Flag = False ' Pour le tri décroissant
If Flag = True Then
Cells(1, 5) = Timer() - tt ' Pour le tri croissant
Cells(1, 3) = "tri croissant"
'MsgBox Timer() - tt
Else
Cells(2, 5) = Timer() - tt ' Pour le tri décroissant
Cells(1, 3) = "tri décroissant"
'MsgBox Timer() - tt
End If
' Afficher le tableau trié
Cells(2, 3).Resize(UBound(t, 1), UBound(t, 2)) = t
End Sub
Sub IntroSort(arr() As Variant, ByVal isAscending As Boolean)
Dim low As Long, high As Long
low = LBound(arr)
high = UBound(arr)
IntroSortRecursive arr, low, high, 2 * Log2(high - low + 1), isAscending
End Sub
Sub IntroSortRecursive(arr() As Variant, ByVal low As Long, ByVal high As Long, ByVal maxDepth As Long, ByVal isAscending As Boolean)
If high <= low Then Exit Sub
If maxDepth = 0 Then
' Si la profondeur maximale est atteinte, utilisez un algorithme de tri plus simple (par exemple, le tri par insertion).
InsertionSort arr, low, high, isAscending
Else
Dim pivotIndex As Long
If isAscending Then
pivotIndex = Partition(arr, low, high, isAscending)
Else
pivotIndex = Partition(arr, low, high, isAscending)
End If
IntroSortRecursive arr, low, pivotIndex - 1, maxDepth - 1, isAscending
IntroSortRecursive arr, pivotIndex + 1, high, maxDepth - 1, isAscending
End If
End Sub
Function Partition(arr() As Variant, ByVal low As Long, ByVal high As Long, ByVal isAscending As Boolean) As Long
Dim pivot As Variant
pivot = arr(low, 1)
Dim i As Long
Dim j As Long
i = low
j = high + 1
Do
If isAscending = True Then
'le tri croissant :
' ----------------
Do
i = i + 1
On Error Resume Next
Loop While arr(i, 1) < pivot And i <= high ' Changer pour le tri croissant
On Error GoTo 0
Do
j = j - 1
Loop While arr(j, 1) > pivot
Else
'le tri décroissant :
' -----------------
Do
i = i + 1
On Error Resume Next
Loop While arr(i, 1) > pivot And i <= high ' Changer pour le tri décroissant
On Error GoTo 0
Do
j = j - 1
Loop While arr(j, 1) < pivot
End If
If i < j Then
' Échanger les éléments
Dim temp As Variant
temp = arr(i, 1)
arr(i, 1) = arr(j, 1)
arr(j, 1) = temp
End If
Loop While i < j
' Échanger pivot avec l'élément à la position j
arr(low, 1) = arr(j, 1)
arr(j, 1) = pivot
Partition = j
End Function
Sub InsertionSort(arr() As Variant, ByVal low As Long, ByVal high As Long, ByVal isAscending As Boolean)
Dim i As Long, j As Long
For i = low + 1 To high
j = i
While j > low And (IIf(isAscending, arr(j, 1) < arr(j - 1, 1), arr(j, 1) > arr(j - 1, 1)))
Swap arr(j, 1), arr(j - 1, 1)
j = j - 1
Wend
Next
End Sub
Sub Swap(ByRef a As Variant, ByRef b As Variant)
Dim temp As Variant
temp = a
a = b
b = temp
End Sub
Function Log2(ByVal x As Double) As Long
Log2 = WorksheetFunction.RoundDown(Log(x) / Log(2), 0)
End Function