Excel VBA按照降序对数组进行sorting的最快方法?

什么是最快的方法(在计算时间方面)以降序sorting一组数字(1000-10000个数字,但可能会有所不同)? 据我所知,Excel内build函数不是很有效,内存中的sorting应该比Excel函数快很多。

请注意,我无法在电子表格上创build任何内容,所有内容都必须存储并仅在内存中进行sorting。

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

这使用快速sorting。

为了让人们不必点击我刚刚做的链接,这里就是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 

我已经成功地使用了Shellsortingalgorithm。 在用VBA Rnd()函数生成的数组进行N = 10000的testing时眨眼间运行 – 不要忘记使用Randomize语句来生成testing数组。 实施起来很简单,而且我所处理的要素数量也足够短而且有效。 在代码注释中给出了参考。

 ' 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 

我知道OP指定不使用工作表,但值得注意的是创build一个新的工作表,使用它作为便笺与工作表函数进行sorting,然后清理后的长度不到2倍。但是,你也有Sort WorkSheet Function的参数提供的所有灵活性。

在我的系统中,@ tannman357的非常漂亮的recursion例程和下面的方法的差别是55毫秒。 这些是平均几次运行。

 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 

如果你想要高效的algorithm,那么看看Timsort 。 这是合并sorting的修改,以解决问题。

 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数据条目数量太less,您不必担心内置的search效率。


例如:如果您有从列A到D的数据,并且标题在第2行,并且您想按列Bsorting。

 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