Quel est le moyen le plus rapide (en termes de temps de calcul) de trier un tableau de nombres (1000-10000 nombres mais peut varier) par ordre décroissant? Autant que je sache, les fonctions intégrées d'Excel ne sont pas vraiment efficaces et le tri en mémoire devrait être beaucoup plus rapide que les fonctions Excel.
Notez que je ne peux rien créer sur la feuille de calcul, tout doit être stocké et trié en mémoire uniquement.
Vous pouvez utiliser System.Collections.ArrayList
:
Dim arr As Object
Dim cell As Range
Set arr = CreateObject("System.Collections.ArrayList")
' Initialise the ArrayList, for instance by taking values from a range:
For Each cell In Range("A1:F1")
arr.Add cell.Value
Next
arr.Sort
' Optionally reverse the order
arr.Reverse
Ceci utilise le tri rapide.
Pour que les gens n'aient pas à cliquer sur le lien que je viens de faire, voici l'un des exemples fantastiques tirés du commentaire de Siddharth.
Option Explicit
Option Compare Text
' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub QuickSort(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim lngFirst As Long
Dim lngLast As Long
Dim varMid As Variant
Dim varSwap As Variant
If plngRight = 0 Then
plngLeft = LBound(pvarArray)
plngRight = UBound(pvarArray)
End If
lngFirst = plngLeft
lngLast = plngRight
varMid = pvarArray((plngLeft + plngRight) \ 2)
Do
Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
lngFirst = lngFirst + 1
Loop
Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
lngLast = lngLast - 1
Loop
If lngFirst <= lngLast Then
varSwap = pvarArray(lngFirst)
pvarArray(lngFirst) = pvarArray(lngLast)
pvarArray(lngLast) = varSwap
lngFirst = lngFirst + 1
lngLast = lngLast - 1
End If
Loop Until lngFirst > lngLast
If plngLeft < lngLast Then QuickSort pvarArray, plngLeft, lngLast
If lngFirst < plngRight Then QuickSort pvarArray, lngFirst, plngRight
End Sub
J'ai utilisé l'algorithme de tri Shell avec succès. S'exécute en un clin d'œil lorsque N = 10000 est testé à l'aide d'un tableau généré à l'aide de la fonction VBA Rnd () - n'oubliez pas d'utiliser l'instruction Randomize pour générer des tableaux de tests. C'était facile à mettre en œuvre et suffisamment court et efficace pour le nombre d'éléments que je traitais. Référence est donnée dans les commentaires du code.
' Shell sort algorithm for sorting a double from largest to smallest.
' Adopted from "Numerical Recipes in C" aka NRC 2nd Edition p330ff.
' Speed is on the range of N^1.25 to N^1.5 (somewhere between bubble and quicksort)
' Refer to the NRC reference for more details on efficiency.
'
Private Sub ShellSortDescending(ByRef a() As Double, N As Integer)
' requires a(1..N)
Debug.Assert LBound(a) = 1
' setup
Dim i, j, inc As Integer
Dim v As Double
inc = 1
' determine the starting incriment
Do
inc = inc * 3
inc = inc + 1
Loop While inc <= N
' loop over the partial sorts
Do
inc = inc / 3
' Outer loop of straigh insertion
For i = inc + 1 To N
v = a(i)
j = i
' Inner loop of straight insertion
' switch to a(j - inc) > v for ascending
Do While a(j - inc) < v
a(j) = a(j - inc)
j = j - inc
If j <= inc Then Exit Do
Loop
a(j) = v
Next i
Loop While inc > 1
End Sub
Je sais que l'OP spécifié n'utilise pas de feuilles de calcul, mais il est intéressant de noter que la création d'une nouvelle feuille de calcul, son utilisation comme bloc-notes pour effectuer le tri avec les fonctions de la feuille de calcul, le nettoyage après est plus long d'un facteur 2, toute la flexibilité offerte par les paramètres de la fonction Sort WorkSheet.
Sur mon système, la différence était de 55 ms pour la très belle routine récursive de @ tannman357 et de 96 ms pour la méthode ci-dessous. Ce sont des temps moyens sur plusieurs manches.
Sub rangeSort(ByRef a As Variant)
Const myName As String = "Module1.rangeSort"
Dim db As New cDebugReporter
db.Report caller:=myName
Dim r As Range, va As Variant, ws As Worksheet
quietMode qmON
Set ws = ActiveWorkbook.Sheets.Add
Set r = ws.Cells(1, 1).Resize(UBound(a), 1)
r.Value2 = rangeVariant(a)
r.Sort Key1:=r.Cells(1), Order1:=xlDescending
va = r.Value2
GetColumn va, a, 1
ws.Delete
quietMode qmOFF
End Sub
Function rangeVariant(a As Variant) As Variant
Dim va As Variant, i As Long
ReDim va(LBound(a) To UBound(a), 0)
For i = LBound(a) To UBound(a)
va(i, 0) = a(i)
Next i
rangeVariant = va
End Function
Sub quietMode(state As qmState)
Static currentState As Boolean
With Application
Select Case state
Case qmON
currentState = .ScreenUpdating
If currentState Then .ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
Case qmOFF
If currentState Then .ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
Case Else
End Select
End With
End Sub
J'ai déjà moi-même répondu à cette question il y a longtemps, ce qui signifie que je devais revenir à mes tous premiers fichiers archivés VBA. J'ai donc retrouvé cet ancien code, extrait d'un livre. enregistre les valeurs (de la sélection intersectée avec une colonne de table) dans le tableau ar (x), puis les trie du plus petit au plus grand. le second (pour x = 1 à n suivant) compare la valeur a(x) avec la valeur a (x + 1), en conservant dans a(x) le plus grand nombre et en ar (x + 1) le plus petit nombre. Le premier beute se répète jusqu'à ce qu'il soit trié du plus petit au plus grand. J'ai effectivement utilisé ce code pour insérer une ligne au-dessus de chaque cellule sélectionnée [Descripcion]). J'espère que ça aide!
Sub Sorting()
Dim ar() As Integer, AX As Integer
Set rng = Intersect(Selection, Range("TblPpto[Descripcion]")) 'Cells selected in Table column
n = rng.Cells.Count 'Number of rows
ReDim ar(1 To n)
x = 1
For Each Cell In rng.Cells
ar(x) = Cell.Row 'Save rows numbers to array ar()
x = x + 1
Next
Do 'Sort array ar() values
sw = 0 'Condition to finish bucle
For x = 1 To n - 1
If ar(x) > ar(x + 1) Then 'If ar(x) is bigger
AX = ar(x) 'AX gets bigger number
ar(x) = ar(x + 1) 'ar(x) changes to smaller number
ar(x + 1) = AX 'ar(x+1) changes to bigger number
sw = 1 'Not finished sorting
End If
Next
Loop Until sw = 0
'Insert rows in TblPpto
fila = Range("TblPpto[#Headers]").Row
For x = n To 1 Step -1
[TblPpto].Rows(ar(x) - fila).EntireRow.Insert
Next x
End Sub
Si vous voulez un algorithme efficace, jetez un coup d'œil à Timsort . C'est l'adaptation du type de fusion qui résout ses problèmes.
Case Timsort Introsort Merge sort Quicksort Insertion sort Selection sort
Best Ɵ(n) Ɵ(n log n) Ɵ(n log n) Ɵ(n) Ɵ(n^2) Ɵ(n)
Average Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n^2) Ɵ(n^2)
Worst Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n^2) Ɵ(n^2) Ɵ(n^2)
Cependant, les entrées de données 1k - 10k sont beaucoup trop peu de données pour que vous puissiez vous inquiéter de l'efficacité de la recherche intégrée.
Exemple: Si vous avez des données de la colonne A à D _ et l'en-tête est à la ligne 2 et que vous voulez trier par colonne B.
Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A3:D" & lastrow).Sort key1:=Range("B3:B" & lastrow), _
order1:=xlAscending, Header:=xlNo