VBA数组排序功能?
时间:2020-03-06 14:54:52 来源:igfitidea点击:
我正在为VBA中的数组寻找一种体面的排序实现。最好使用Quicksort。或者,除了冒泡或者合并以外的任何其他排序算法都足够。
请注意,这是与MS Project 2003一起使用的,因此应避免使用任何Excel本机功能以及与.net相关的任何内容。
解决方案
在这里看看:
编辑:引用的源(allexperts.com)已关闭,但是这里是相关的作者评论:
There are many algorithms available on the web for sorting. The most versatile and usually the quickest is the Quicksort algorithm. Below is a function for it. Call it simply by passing an array of values (string or numeric; it doesn't matter) with the Lower Array Boundary (usually 0) and the Upper Array Boundary (i.e. UBound(myArray).) Example: Call QuickSort(myArray, 0, UBound(myArray)) When it's done, myArray will be sorted and you can do what you want with it. (Source: archive.org)
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long) Dim pivot As Variant Dim tmpSwap As Variant Dim tmpLow As Long Dim tmpHi As Long tmpLow = inLow tmpHi = inHi pivot = vArray((inLow + inHi) \ 2) While (tmpLow <= tmpHi) While (vArray(tmpLow) < pivot And tmpLow < inHi) tmpLow = tmpLow + 1 Wend While (pivot < vArray(tmpHi) And tmpHi > inLow) tmpHi = tmpHi - 1 Wend If (tmpLow <= tmpHi) Then tmpSwap = vArray(tmpLow) vArray(tmpLow) = vArray(tmpHi) vArray(tmpHi) = tmpSwap tmpLow = tmpLow + 1 tmpHi = tmpHi - 1 End If Wend If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi End Sub
请注意,这仅适用于一维(也称为"正常"?)阵列。 (这里有一个有效的多维数组QuickSort。)
用德语解释,但代码是经过充分测试的就地实现:
Private Sub QuickSort(ByRef Field() As String, ByVal LB As Long, ByVal UB As Long) Dim P1 As Long, P2 As Long, Ref As String, TEMP As String P1 = LB P2 = UB Ref = Field((P1 + P2) / 2) Do Do While (Field(P1) < Ref) P1 = P1 + 1 Loop Do While (Field(P2) > Ref) P2 = P2 - 1 Loop If P1 <= P2 Then TEMP = Field(P1) Field(P1) = Field(P2) Field(P2) = TEMP P1 = P1 + 1 P2 = P2 - 1 End If Loop Until (P1 > P2) If LB < P2 Then Call QuickSort(Field, LB, P2) If P1 < UB Then Call QuickSort(Field, P1, UB) End Sub
像这样调用:
Call QuickSort(MyArray, LBound(MyArray), UBound(MyArray))
如果有人需要,我将"快速快速排序"算法转换为VBA。
我已经对其进行了优化以在一个Int / Longs数组上运行,但是将其转换为对任意可比较元素均适用的数组应该很简单。
Private Sub QuickSort(ByRef a() As Long, ByVal l As Long, ByVal r As Long) Dim M As Long, i As Long, j As Long, v As Long M = 4 If ((r - l) > M) Then i = (r + l) / 2 If (a(l) > a(i)) Then swap a, l, i '// Tri-Median Methode!' If (a(l) > a(r)) Then swap a, l, r If (a(i) > a(r)) Then swap a, i, r j = r - 1 swap a, i, j i = l v = a(j) Do Do: i = i + 1: Loop While (a(i) < v) Do: j = j - 1: Loop While (a(j) > v) If (j < i) Then Exit Do swap a, i, j Loop swap a, i, r - 1 QuickSort a, l, j QuickSort a, i + 1, r End If End Sub Private Sub swap(ByRef a() As Long, ByVal i As Long, ByVal j As Long) Dim T As Long T = a(i) a(i) = a(j) a(j) = T End Sub Private Sub InsertionSort(ByRef a(), ByVal lo0 As Long, ByVal hi0 As Long) Dim i As Long, j As Long, v As Long For i = lo0 + 1 To hi0 v = a(i) j = i Do While j > lo0 If Not a(j - 1) > v Then Exit Do a(j) = a(j - 1) j = j - 1 Loop a(j) = v Next i End Sub Public Sub sort(ByRef a() As Long) QuickSort a, LBound(a), UBound(a) InsertionSort a, LBound(a), UBound(a) End Sub