首先:不要在5000行上使用冒泡排序!这将需要5000 ^
2/2次迭代,即12.5B次迭代!最好使用像样的QuickSort算法。在本文的底部,您将找到一个可以用作起点的文章。它仅比较第1列。在我的系统上,花费了0.01秒的排序(而不是优化冒泡排序后的4秒)。
现在,面对挑战,请查看下面的代码。它以原始运行时间的〜30%运行-同时显着减少了代码行。
主要杠杆是:
- 对主数组使用Double而不是Variant(在内存管理方面,Variant总是会产生一些开销)
- 减少变量的调用/切换次数-我内联代码并对其进行了优化,而不是使用您的subs CompareOne和CompareTwo。另外,我直接访问了这些值,而没有将它们分配给temp变量
- 仅填充阵列就花费了总时间的10%。相反,我批量分配了数组(不得不为此切换行和列),然后将其强制转换为双精度数组
通过具有两个单独的回路可以进一步优化速度-一个回路用于一列,一个回路用于两列。这样可以将运行时间减少约10%,但会使代码过大,因此省略了代码。
Option Explicit
Sub sortA()
Dim start_time As DoubleDim varArray As Variant, dblArray() As DoubleDim a, b As LongConst rows As Long = 5000Const cols As Long = 3start_time = Timer'Copy everything to array of type variantvarArray = ArraySheet.Range("A1").Resize(rows, cols).Cells'Cast variant to doubleReDim dblArray(1 To rows, 1 To cols)For a = 1 To rows For b = 1 To cols dblArray(a, b) = varArray(a, b) Next bNext aBubbleSort dblArray, 1, False, 2, TrueMsgBox Format(Timer - start_time, "0.00")
End Sub
‘Array Must Be: Array(Column,Row)
Sub BubbleSort(ThisArray() As Double, SortColumn1 As Long, Asc1 As Boolean, Optional SortColumn2 As Long = -1, Optional Asc2 As Boolean)Dim LastRow As LongDim FirstCol As LongDim LastCol As LongDim lTemp As DoubleDim i, j, k As LongDim CompareResult As BooleanLastRow = UBound(ThisArray, 1)FirstCol = LBound(ThisArray, 2)LastCol = UBound(ThisArray, 2)For i = LBound(ThisArray, 1) To LastRow For j = i + 1 To LastRow If SortColumn2 = -1 Then 'If there is only one column to sort by CompareResult = ThisArray(i, SortColumn1) <= ThisArray(j, SortColumn1) If Asc1 Then CompareResult = Not CompareResult Else 'If there are two columns to sort by Select Case ThisArray(i, SortColumn1) Case Is < ThisArray(j, SortColumn1): CompareResult = Not Asc1 Case Is > ThisArray(j, SortColumn1): CompareResult = Asc1 Case Else CompareResult = ThisArray(i, SortColumn2) <= ThisArray(j, SortColumn2) If Asc2 Then CompareResult = Not CompareResult End Select End If If CompareResult Then ' If compare result returns true, Flip rows For k = FirstCol To LastCol lTemp = ThisArray(j, k) ThisArray(j, k) = ThisArray(i, k) ThisArray(i, k) = lTemp Next k End If Next jNext i
End Sub
这是一个QuickSort实现:
Public Sub subQuickSort(var1 As Variant, _ Optional ByVal lngLowStart As Long = -1, _ Optional ByVal lngHighStart As Long = -1) Dim varPivot As Variant Dim lngLow As Long Dim lngHigh As Long lngLowStart = IIf(lngLowStart = -1, LBound(var1), lngLowStart) lngHighStart = IIf(lngHighStart = -1, UBound(var1), lngHighStart) lngLow = lngLowStart lngHigh = lngHighStart varPivot = var1((lngLowStart + lngHighStart) 2, 1) While (lngLow <= lngHigh) While (var1(lngLow, 1) < varPivot And lngLow < lngHighStart) lngLow = lngLow + 1 Wend While (varPivot < var1(lngHigh, 1) And lngHigh > lngLowStart) lngHigh = lngHigh - 1 Wend If (lngLow <= lngHigh) Then subSwap var1, lngLow, lngHigh lngLow = lngLow + 1 lngHigh = lngHigh - 1 End If Wend If (lngLowStart < lngHigh) Then subQuickSort var1, lngLowStart, lngHigh End If If (lngLow < lngHighStart) Then subQuickSort var1, lngLow, lngHighStart End IfEnd SubPrivate Sub subSwap(var As Variant, lngItem1 As Long, lngItem2 As Long) Dim varTemp As Variant varTemp = var(lngItem1, 1) var(lngItem1, 1) = var(lngItem2, 1) var(lngItem2, 1) = varTempEnd Sub
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)