VBA排序的10种方法之基数排序

2015-04-13 13:44 阅读 86 次 评论关闭

VBA排序的10种方法之基数排序

Public Sub RadixSort(ByRef lngArray() As Long)
Dim arrTemp() As Long
Dim iLBound As Long
Dim iUBound As Long
Dim iMax As Long
Dim iSorts As Long
Dim iLoop As Long

iLBound = LBound(lngArray)
iUBound = UBound(lngArray)

'Create swap array
ReDim arrTemp(iLBound To iUBound)

iMax = &H80000000
'Find largest
For iLoop = iLBound To iUBound
If lngArray(iLoop) > iMax Then iMax = lngArray(iLoop)
Next iLoop

'Calculate how many sorts are needed
Do While iMax
iSorts = iSorts + 1
iMax = iMax \ 256
Loop

iMax = 1

'Do the sorts
For iLoop = 1 To iSorts

If iLoop And 1 Then
'Odd sort -> src to dest
InnerRadixSort lngArray, arrTemp, iLBound, iUBound, iMax
Else
'Even sort -> dest to src
InnerRadixSort arrTemp, lngArray, iLBound, iUBound, iMax
End If

'Next sort factor
iMax = iMax * 256
Next iLoop

'If odd number of sorts we need to swap the arrays
If (iSorts And 1) Then
For iLoop = iLBound To iUBound
lngArray(iLoop) = arrTemp(iLoop)
Next iLoop
End If
End Sub

Private Sub InnerRadixSort(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iLBound As Long, ByVal iUBound As Long, ByVal iDivisor As Long)
Dim arrCounts(255) As Long
Dim arrOffsets(255) As Long
Dim iBucket As Long
Dim iLoop As Long

'Count the items for each bucket
For iLoop = iLBound To iUBound
iBucket = (lngSrc(iLoop) \ iDivisor) And 255
arrCounts(iBucket) = arrCounts(iBucket) + 1
Next iLoop

'Generate offsets
For iLoop = 1 To 255
arrOffsets(iLoop) = arrOffsets(iLoop - 1) + arrCounts(iLoop - 1) + iLBound
Next iLoop

'Fill the buckets
For iLoop = iLBound To iUBound
iBucket = (lngSrc(iLoop) \ iDivisor) And 255
lngDest(arrOffsets(iBucket)) = lngSrc(iLoop)
arrOffsets(iBucket) = arrOffsets(iBucket) + 1
Next iLoop
End Sub

版权声明:本文著作权归原作者所有,欢迎分享本文,谢谢支持!
转载请注明:VBA排序的10种方法之基数排序 | 猎微网
分类:VBA 标签:, ,

评论已关闭!