VB排序算法－堆排序

'堆排序
Sub Heap(MyArray())
    Dim Index
    Dim size
    Dim temp
    
    '读取最大下标
    size = UBound(MyArray)
    '将当前要处理的置为1
    Index = 1
    '处理每一个元素
    While (Index <= size)
        '向上筛选
        Call HeapSiftup(MyArray(), Index)
        Index = Index + 1
    Wend
    Index = size
    While (Index > 0)
        '当前值与第一个值互换
        temp = MyArray(0)
        MyArray(0) = MyArray(Index)
        MyArray(Index) = temp
        '向下筛选
        Call HeapSiftdown(MyArray(), Index - 1)
        Index = Index - 1
    Wend
End Sub
'堆排序的向下筛选子程序
Sub HeapSiftdown(MyArray(), M)
    Dim Index
    Dim Parent
    Dim temp
    Index = 0
    'Parent位置定位于2 * Index
    Parent = 2 * Index
    Do While (Parent <= M)
        '如果当前Parent位的值后面的值要大,向后移Parent位
        If (Parent < M And MyArray(Parent) < MyArray(Parent + 1)) Then
            Parent = Parent + 1
        End If
        '如果当前值大于Parent位的值,结束筛选
        If MyArray(Index) >= MyArray(Parent) Then
            Exit Do
        End If
        '否则交换两个值
        temp = MyArray(Index)
        MyArray(Index) = MyArray(Parent)
        MyArray(Parent) = temp
        '当前位置移到Parent
        Index = Parent
        Parent = 2 * Index
    Loop
End Sub
'堆排序的向上筛选子程序
Sub HeapSiftup(MyArray(), M)
    Dim Index
    Dim Parent
    Dim temp
    Index = M
    Do While (Index > 0)
        '只要Index / 2位置的值大于当前值就结束筛选
        Parent = Int(Index / 2)
        If MyArray(Parent) >= MyArray(Index) Then
            Exit Do
        End If
        '否则交换两值
        temp = MyArray(Index)
        MyArray(Index) = MyArray(Parent)
        MyArray(Parent) = temp
        '将当前点移到Index / 2
        Index = Parent
    Loop
End Sub