Je pense que le temps et variable en fonction des ordinateurs ?Oui il y a un pivot comme le quicksort et il est très rapide, de toute manière je ne suis pas à une seconde prés car avec 60 000 il met moins de 1 seconde
Avec plaisir de le tester en tris croissant et décroissant et tester sur les mêmes valeurs, je pense avoir trouver un code assez performant.oui Laurent 5 minute j'ajoute le trishellmetsner
Le plus rapide chez moi avec ton code le plus rapide c'est 0,05 sec est chez toi ?les modules sont classés de la méthode la plus lente à la plus rapide
Sub TestQuickSortCroissant()
Dim t() As Variant
Range(Cells(1, 3), Cells(Cells(65536, 3).End(xlUp).Row, 3)).Clear
t = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row, 1))
tt = Timer()
IntroSort t
MsgBox Timer() - tt
' Afficher le tableau tris Croissant
Cells(1, 3).Resize(UBound(t, 1), UBound(t, 2)) = t
'Dim i As Long
'For i = LBound(t) To UBound(t)
'Debug.Print t(i)
'Next i
End Sub
Sub IntroSort(arr() As Variant)
Dim low As Long, high As Long
low = LBound(arr)
high = UBound(arr)
IntroSortRecursive arr, low, high, 2 * Log2(high - low + 1)
End Sub
Sub IntroSortRecursive(arr() As Variant, ByVal low As Long, ByVal high As Long, ByVal maxDepth As Long)
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
Else
Dim pivotIndex As Long
pivotIndex = Partition(arr, low, high)
IntroSortRecursive arr, low, pivotIndex - 1, maxDepth - 1
IntroSortRecursive arr, pivotIndex + 1, high, maxDepth - 1
End If
End Sub
Function Partition(arr() As Variant, ByVal low As Long, ByVal high As Long) As Long
Dim pivot As Variant
Dim i As Long, j As Long
Dim temp As Variant
' Choisissez un pivot médian
Dim mid As Long
mid = (low + high) \ 2
pivot = arr(mid, 1)
i = low
j = high
Do
While arr(i, 1) < pivot
i = i + 1
Wend
While arr(j, 1) > pivot
j = j - 1
Wend
If i <= j Then
' Échange les éléments
temp = arr(i, 1)
arr(i, 1) = arr(j, 1)
arr(j, 1) = temp
i = i + 1
j = j - 1
End If
Loop While i <= j
Partition = i
End Function
Sub InsertionSort(arr() As Variant, ByVal low As Long, ByVal high As Long)
Dim i As Long, j As Long
For i = low + 1 To high
j = i
While j > low And 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
Sub TestQuickSortDeCroissant()
Dim t() As Variant
Range(Cells(1, 3), Cells(Cells(65536, 3).End(xlUp).Row, 3)).Clear
t = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row, 1))
tt = Timer()
IntroSort t
MsgBox Timer() - tt
' Afficher le tableau tris Croissant
Cells(1, 3).Resize(UBound(t, 1), UBound(t, 2)) = t
'Dim i As Long
'For i = LBound(t) To UBound(t)
'Debug.Print t(i)
'Next i
End Sub
Sub IntroSort(arr() As Variant)
Dim low As Long, high As Long
low = LBound(arr)
high = UBound(arr)
IntroSortRecursive arr, low, high, 2 * Log2(high - low + 1)
End Sub
Sub IntroSortRecursive(arr() As Variant, ByVal low As Long, ByVal high As Long, ByVal maxDepth As Long)
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
Else
Dim pivotIndex As Long
pivotIndex = Partition(arr, low, high)
IntroSortRecursive arr, low, pivotIndex - 1, maxDepth - 1
IntroSortRecursive arr, pivotIndex + 1, high, maxDepth - 1
End If
End Sub
Function Partition(arr() As Variant, ByVal low As Long, ByVal high As Long) As Long
Dim pivot As Variant
Dim i As Long, j As Long
Dim temp As Variant
' Choisissez un pivot médian
Dim mid As Long
mid = (low + high) \ 2
pivot = arr(mid, 1)
i = low
j = high
Do
While arr(i, 1) > pivot
i = i + 1
Wend
While arr(j, 1) < pivot
j = j - 1
Wend
If i <= j Then
' Échange les éléments
temp = arr(i, 1)
arr(i, 1) = arr(j, 1)
arr(j, 1) = temp
i = i + 1
j = j - 1
End If
Loop While i <= j
Partition = i
End Function
Sub InsertionSort(arr() As Variant, ByVal low As Long, ByVal high As Long)
Dim i As Long, j As Long
For i = low + 1 To high
j = i
While j > low And 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