VBAの配列をクイックソートで並べ替え

VBAでのクイックソート

今、このページを見ているということは、よほど高速に処理したいということではないかと思います。

高速な並べ替えと言えば「クイックソート」です。一般的にはいろんなソート処理の中でも最速と言われています。ただ、「最速」といっても一般的にであって、ほとんど整列済みのデータの場合は挿入ソートの方が速いなど、一概に最速とは言えない点もあります。また、高速ではあるものの仕組みが複雑なため、当然、実装も複雑になる欠点があります。

そして、こんなページを書いておきながらなんですが、「どうにかこうにか高速に並べ替え処理したい」という場合であれば、VBAでクイックソートを実装するのではなくVBAから離れる（ソート部分を別の仕組みにしたり、C言語等のライブラリを使うなどする）のも一つの方法です。とはいえ、そういう話になるともうExcel効率化というよりもシステム開発の感じにはなりますね。

他のソートについては以下をご参照ください。
「VBAの配列をバブルソートで並べ替え」
「VBAの配列を挿入ソートで並べ替え」
「VBAの配列を.NETのArrayListのSortで並べ替え」
「VBAの配列を逆順に並べ替え」

クイックソートの仕組み

以下のクイックソート関数の仕組みを簡単に説明します。

配列の中の中央の要素値を取得する。（中央要素値とします）
配列を先頭から見ていき、中央要素値以上の値を探す。
配列を最後から見ていき、中央要素値以下の値を探す。
それぞれ見つかった位置が先頭から探した方が、最後から探した方より右にある場合は中央要素値以上、以下の値の探索を終了する。
上記の条件に合致しない場合は、見つかった大小の値を入れ替える。
先頭を１つ右に、最後を１つ左にずらして、再度2.に戻る。
中央値の左側を再帰でクイックソートする。
中央値の右側を再帰でクイックソートする。

コード

以下の関数は引数で渡された一次元配列の並び順をクイックソートで昇順に並べなおします。

引数は配列、ソート開始位置、ソート終了位置の3つがあります。

2番目と3番目の引数は配列の一部だけをソートしたい場合に設定します。通常は省略して構いません。

Sub quicksort(a_Ar(), Optional iFirst As Integer = 0, Optional iLast As Integer = -1)
    Dim iLeft                   As Integer      '// 左ループカウンタ
    Dim iRight                  As Integer      '// 右ループカウンタ
    Dim sMedian                                 '// 中央値
    Dim tmp                                     '// 配列移動用バッファ
    
    '// ソート終了位置省略時は配列要素数を設定
    If (iLast = -1) Then
        iLast = UBound(a_Ar)
    End If
    
    '// 中央値を取得
    sMedian = a_Ar(Int((iFirst + iLast) / 2))
    
    iLeft = iFirst
    iRight = iLast
    
    Do
        '// 中央値の左側をループ
        Do
            '// 配列の左側から中央値より大きい値を探す
            If (a_Ar(iLeft) >= sMedian) Then
                Exit Do
            End If
            
            '// 左側を１つ右にずらす
            iLeft = iLeft + 1
        Loop
        
        '// 中央値の右側をループ
        Do
            '// 配列の右側から中央値より大きい値を探す
            If (sMedian >= a_Ar(iRight)) Then
                Exit Do
            End If
            
            '// 右側を１つ左にずらす
            iRight = iRight - 1
        Loop
        
        '// 左側の方が大きければここで処理終了
        If (iLeft >= iRight) Then
            Exit Do
        End If
        
        '// 右側の方が大きい場合は、左右を入れ替える
        tmp = a_Ar(iLeft)
        a_Ar(iLeft) = a_Ar(iRight)
        a_Ar(iRight) = tmp
        
        '// 左側を１つ右にずらす
        iLeft = iLeft + 1
        '// 右側を１つ左にずらす
        iRight = iRight - 1
    Loop
    
    '// 中央値の左側を再帰でクイックソート
    If (iFirst < iLeft - 1) Then
        Call quicksort(a_Ar, iFirst, iLeft - 1)
    End If
    
    '// 中央値の右側を再帰でクイックソート
    If (iRight + 1 < iLast) Then
        Call quicksort(a_Ar, iRight + 1, iLast)
    End If
    
End Sub

Sub quicksort(a_Ar(), Optional iFirst As Integer = 0, Optional iLast As Integer = -1)

Dim iLeft As Integer '// 左ループカウンタ

Dim iRight As Integer '// 右ループカウンタ

Dim sMedian '// 中央値

Dim tmp '// 配列移動用バッファ

'// ソート終了位置省略時は配列要素数を設定

If (iLast = -1) Then

iLast = UBound(a_Ar)

End If

'// 中央値を取得

sMedian = a_Ar(Int((iFirst + iLast) / 2))

iLeft = iFirst

iRight = iLast

'// 中央値の左側をループ

'// 配列の左側から中央値より大きい値を探す

If (a_Ar(iLeft) >= sMedian) Then

Exit Do

End If

'// 左側を１つ右にずらす

iLeft = iLeft + 1

Loop

'// 中央値の右側をループ

'// 配列の右側から中央値より大きい値を探す

If (sMedian >= a_Ar(iRight)) Then

Exit Do

End If

'// 右側を１つ左にずらす

iRight = iRight - 1

Loop

'// 左側の方が大きければここで処理終了

If (iLeft >= iRight) Then

Exit Do

End If

'// 右側の方が大きい場合は、左右を入れ替える

tmp = a_Ar(iLeft)

a_Ar(iLeft) = a_Ar(iRight)

a_Ar(iRight) = tmp

'// 左側を１つ右にずらす

iLeft = iLeft + 1

'// 右側を１つ左にずらす

iRight = iRight - 1

Loop

'// 中央値の左側を再帰でクイックソート

If (iFirst < iLeft - 1) Then

Call quicksort(a_Ar, iFirst, iLeft - 1)

End If

'// 中央値の右側を再帰でクイックソート

If (iRight + 1 < iLast) Then

Call quicksort(a_Ar, iRight + 1, iLast)

End If

End Sub

昇順ではなく降順にしたい場合は、大小比較や入れ替え部分を反対にすれば可能になります。

または別ページ「VBAの配列を逆順に並べ替え」のようなコードで昇順と降順を入れ替えるのもありです。

利用方法

利用方法はこのような感じになります。

Sub sorttest()
    Dim ar()
    
    ReDim ar(10)
    ar(0) = "9"
    ar(1) = "8"
    ar(2) = "7"
    ar(3) = "6"
    ar(4) = "5"
    ar(5) = "4"
    ar(6) = "3"
    ar(7) = "2"
    ar(8) = "1"
    ar(9) = "0"
    ar(10) = "a"
    
    'Call quicksort(ar, 0, UBound(ar))
    Call quicksort(ar) '// こちらのように引数は省略しても構いません
End Sub

Sub sorttest()

Dim ar()

ReDim ar(10)

ar(0) = "9"

ar(1) = "8"

ar(2) = "7"

ar(3) = "6"

ar(4) = "5"

ar(5) = "4"

ar(6) = "3"

ar(7) = "2"

ar(8) = "1"

ar(9) = "0"

ar(10) = "a"

'Call quicksort(ar, 0, UBound(ar))

Call quicksort(ar) '// こちらのように引数は省略しても構いません

End Sub

ソート後は、以下の順になります。

    ar(0) = "0"
    ar(1) = "1"
    ar(2) = "2"
    ar(3) = "3"
    ar(4) = "4"
    ar(5) = "5"
    ar(6) = "6"
    ar(7) = "7"
    ar(8) = "8"
    ar(9) = "9"
    ar(10) = "a"

ar(0) = "0"

ar(1) = "1"

ar(2) = "2"

ar(3) = "3"

ar(4) = "4"

ar(5) = "5"

ar(6) = "6"

ar(7) = "7"

ar(8) = "8"

ar(9) = "9"

ar(10) = "a"

VBAでのクイックソート

クイックソートの仕組み

コード

利用方法

関連記事