Excel VBA按照降序對數組進行排序的最快方法？

Question

按照降序排序一組數字（1000-10000個數字，但可能會有所不同）的最快方法是什麼（按計算時間）？據我所知，Excel內置函數不是很有效，而且內存中的排序應該比Excel函數快得多。

請注意，我無法在電子表格上創建任何內容，所有內容都必須存儲並僅存儲在內存中。

Answer 1

爲了讓人們不必點擊我剛剛做的鏈接，這裏就是來自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 

Answer 2

我不知道使用工作表，但其值得注意的是，創建一個新的工作表，使用它作爲一個便箋做排序與工作表函數指定的OP，然後不到一個因素後清理愈長爲2.但您也具有Sort WorkSheet Function的參數提供的所有靈活性。

在我的系統中，@ tannman357的非常漂亮的遞歸例程與下面的方法的差別爲55毫秒，96毫秒。這些是幾次運行的平均時間。

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 

Answer 3

如果你想要高效的算法，那麼看看Timsort。它是適應合併排序，修復它的問題。

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) 

但是，1k-10k數據條目數量太少，您不必擔心內置的搜索效率。

---

示例：如果有從柱的數據到d和頭是在第2行並且要通過塔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 

Answer 4

你可以使用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 

這使用快速排序。

Answer 5

我已經成功地使用了Shell排序算法。在使用由VBA Rnd（）函數生成的數組進行N = 10000測試時運行一眨眼之間 - 不要忘記使用Randomize語句來生成測試數組。對於我正在處理的元素的數量來說，實施起來很簡單，效率也很高。代碼註釋中給出了參考。

' 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