Excel VBA façon la plus Rapide pour trier un tableau de nombres dans l'ordre décroissant?

Juste pour que les gens n'ont pas de cliquer sur le lien que je viens de faire, ici, est l'un des exemples fantastiques de Siddharth commentaire.

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

OriginalL'auteur tannman357

Je sais que l'OP spécifié non à l'aide de feuilles de calcul, mais il est intéressant de noter que la création d'une nouvelle Feuille de calcul, l'utiliser comme un bloc-notes pour faire le tri avec les fonctions de feuille de calcul, puis le nettoyage après la plus longue de moins d'un facteur de 2. Mais vous avez également l'ensemble de la souplesse par les paramètres de la Tri Fonction de Feuille de calcul.

Sur mon système, la différence était de 55 ms pour la très belle routine récursive par @tannman357 et 96 ms pour la méthode ci-dessous. Ceux sont des moyennes sur plusieurs pistes.

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

OriginalL'auteur Cool Blue

J'ai répondu à cette question moi-même il y a longtemps, ce qui signifie que je devais revenir à ma première VBA fichiers archivés.
J'ai donc trouvé ce vieux code, que j'ai pris d'un livre.
D'abord, il enregistre des valeurs (à partir de la sélection recoupé avec une colonne de table) à tableau ar(x), puis de les trier du plus petit au plus grand.
Pour trier il y a 2 bucles, le premier (Faire une Boucle Jusqu'à ce sw=0) et la seconde (Pour x=1 À n) compare la valeur de a(x) avec la valeur de a(x+1), en gardant à l'un(x) le plus grand nombre et dans l'ar(x+1) le plus petit nombre.
La première bucle se répète jusqu'à ce est triée forme plus petit au plus grand.
J'ai utilisé ce code à insérer des lignes au-dessus de chaque cellule sélectionnée dans une colonne budget (TblPpto[Descripcion]).
Espérons que cela 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

OriginalL'auteur Jorge Jaime