Excel VBA按照降序对数组进行排序的最快方法?
问题描述:
按照降序排序一组数字(1000-10000个数字,但可能会有所不同)的最快方法是什么(按计算时间)?据我所知,Excel内置函数不是很有效,而且内存中的排序应该比Excel函数快得多。Excel VBA按照降序对数组进行排序的最快方法?
请注意,我无法在电子表格上创建任何内容,所有内容都必须存储并仅存储在内存中。
答
为了让人们不必点击我刚刚做的链接,这里就是来自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
答
我不知道使用工作表,但其值得注意的是,创建一个新的工作表,使用它作为一个便笺做排序与工作表函数指定的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
答
如果你想要高效的算法,那么看看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
答
你可以使用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
这使用快速排序。
答
我已经成功地使用了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
排序数组的完整教程。埃利斯给了你很多选择排序数组:)你可以选择。 http://www.vbforums.com/showthread.php?t=473677 – 2012-07-16 12:40:51
查看帖子http://*.com/a/11012529/797393。 – Cylian 2012-07-16 12:43:39