VBA排序的10种方法之合并排序

2015-04-13 13:38 阅读 93 次 评论关闭

VBA排序的10种方法之合并排序

Public Sub MergeSort(ByRef lngArray() As Long)
Dim arrTemp() As Long
Dim iSegSize As Long
Dim iLBound As Long
Dim iUBound As Long

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

ReDim arrTemp(iLBound To iUBound)

iSegSize = 1
Do While iSegSize < iUBound - iLBound

'合并A到B
InnerMergePass lngArray, arrTemp, iLBound, iUBound, iSegSize
iSegSize = iSegSize + iSegSize

'合并B到A
InnerMergePass arrTemp, lngArray, iLBound, iUBound, iSegSize
iSegSize = iSegSize + iSegSize

Loop
End Sub

Private Sub InnerMergePass(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iLBound As Long, iUBound As Long, ByVal iSegSize As Long)
Dim iSegNext As Long

iSegNext = iLBound

Do While iSegNext <= iUBound - (2 * iSegSize)
'合并
InnerMerge lngSrc, lngDest, iSegNext, iSegNext + iSegSize - 1, iSegNext + iSegSize + iSegSize - 1

iSegNext = iSegNext + iSegSize + iSegSize
Loop

If iSegNext + iSegSize <= iUBound Then
InnerMerge lngSrc, lngDest, iSegNext, iSegNext + iSegSize - 1, iUBound
Else
For iSegNext = iSegNext To iUBound
lngDest(iSegNext) = lngSrc(iSegNext)
Next iSegNext
End If

End Sub

Private Sub InnerMerge(ByRef lngSrc() As Long, ByRef lngDest() As Long, ByVal iStartFirst As Long, ByVal iEndFirst As Long, ByVal iEndSecond As Long)
Dim iFirst As Long
Dim iSecond As Long
Dim iResult As Long
Dim iOuter As Long

iFirst = iStartFirst
iSecond = iEndFirst + 1
iResult = iStartFirst

Do While (iFirst <= iEndFirst) And (iSecond <= iEndSecond)

If lngSrc(iFirst) <= lngSrc(iSecond) Then
lngDest(iResult) = lngSrc(iFirst)
iFirst = iFirst + 1
Else
lngDest(iResult) = lngSrc(iSecond)
iSecond = iSecond + 1
End If

iResult = iResult + 1
Loop

If iFirst > iEndFirst Then
For iOuter = iSecond To iEndSecond
lngDest(iResult) = lngSrc(iOuter)
iResult = iResult + 1
Next iOuter
Else
For iOuter = iFirst To iEndFirst
lngDest(iResult) = lngSrc(iOuter)
iResult = iResult + 1
Next iOuter
End If
End Sub

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

评论已关闭!