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