VBA排序的10种方法之堆排序

2015-04-13 13:39 阅读 111 次 评论关闭

VBA排序的10种方法之堆排序

Public Sub HeapSort(ByRef lngArray() As Long)
Dim iLBound As Long
Dim iUBound As Long
Dim iArrSize As Long
Dim iRoot As Long
Dim iChild As Long
Dim iElement As Long
Dim iCurrent As Long
Dim arrOut() As Long

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

ReDim arrOut(iLBound To iUBound)

'Initialise the heap
'Move up the heap from the bottom
For iRoot = iArrSize \ 2 To 0 Step -1

iElement = lngArray(iRoot + iLBound)
iChild = iRoot + iRoot

'Move down the heap from the current position
Do While iChild < iArrSize

If iChild < iArrSize Then
If lngArray(iChild + iLBound) < lngArray(iChild + iLBound + 1) Then
'Always want largest child
iChild = iChild + 1
End If
End If

'Found a slot, stop looking
If iElement >= lngArray(iChild + iLBound) Then Exit Do

lngArray((iChild \ 2) + iLBound) = lngArray(iChild + iLBound)
iChild = iChild + iChild
Loop

'Move the node
lngArray((iChild \ 2) + iLBound) = iElement
Next iRoot

'Read of values one by one (store in array starting at the end)
For iRoot = iUBound To iLBound Step -1

'Read the value
arrOut(iRoot) = lngArray(iLBound)
'Get the last element
iElement = lngArray(iArrSize + iLBound)

iArrSize = iArrSize - 1
iCurrent = 0
iChild = 1

'Find a place for the last element to go
Do While iChild <= iArrSize

If iChild < iArrSize Then
If lngArray(iChild + iLBound) < lngArray(iChild + iLBound + 1) Then
'Always want the larger child
iChild = iChild + 1
End If
End If

'Found a position
If iElement >= lngArray(iChild + iLBound) Then Exit Do

lngArray(iCurrent + iLBound) = lngArray(iChild + iLBound)
iCurrent = iChild
iChild = iChild + iChild

Loop

'Move the node
lngArray(iCurrent + iLBound) = iElement
Next iRoot

'Copy from temp array to real array
For iRoot = iLBound To iUBound
lngArray(iRoot) = arrOut(iRoot)
Next iRoot
End Sub

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

评论已关闭!