web-dev-qa-db-fra.com

Excel VBA Le moyen le plus rapide de trier un tableau de nombres dans l'ordre décroissant?

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.

arraysexcelvbasorting
10
AZhu

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.

6
trincot

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
2
tannman357

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
1
jdrago

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
0
Cool Blue

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
0
Jorge Jaime

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
0
Margus