VBAでのマージソート サンプル

Excel VBA で配列をソートしたい場合は、ワークシートに出力して Excel のソート機能を使うのが、実装も処理速度も最も良い！のだけれど、そうも行かない事情はよくある話かなぁ？

仕方なく配列のソートを実装する場合のサンプルです。配列をソートする関数などは VBA には残念ながら無く、このコードは他言語のマージソートを VBA に移植したものです。

他言語のMerge Sort
http://www.codecodex.com/wiki/Merge_sort

'マージソート
'配列の添字の最小値は0に限定します
Public Sub MergeSort(List() As String)
    Dim min, max, max1, max2, size As Long
    min = LBound(List)
    max = UBound(List)
    size = max - min + 1

    If min <> 0 Then
        '最小値は0に限定
        Error 1
    ElseIf max = -1 Then
        '配列に要素が無い
        Exit Sub
    ElseIf size = 1 Then
        '配列要素が1つ
        Exit Sub
    End If

    max1 = Int(max / 2)     '少数は切り捨て
    max2 = max - max1 - 1
    Dim List1() As String
    ReDim List1(min To max1)
    Dim List2() As String
    ReDim List2(min To max2)

    Dim idx, idx1, idx2 As Integer
    idx1 = min
    For idx = min To max1
        List1(idx1) = List(idx)
        idx1 = idx1 + 1
    Next

    idx2 = min
    For idx = max1 + 1 To max
        List2(idx2) = List(idx)
        idx2 = idx2 + 1
    Next

    MergeSort List1
    MergeSort List2

    idx = min
    idx1 = min
    idx2 = min
    Do While (idx1 <= max1 And idx2 <= max2)
        If List1(idx1) <= List2(idx2) Then
            List(idx) = List1(idx1)
            idx = idx + 1
            idx1 = idx1 + 1
        Else
            List(idx) = List2(idx2)
            idx = idx + 1
            idx2 = idx2 + 1
        End If
    Loop

    Do While (idx1 <= max1)
        List(idx) = List1(idx1)
        idx = idx + 1
        idx1 = idx1 + 1
    Loop

    Do While (idx2 <= max2)
        List(idx) = List2(idx2)
        idx = idx + 1
        idx2 = idx2 + 1
    Loop

    Erase List1
    Erase List2
End Sub