配列の並び替え

・ＶＢＡでの実装

前頁のVC++ではランタイムライブラリのqsort関数をつかって簡単に配列を並び替えましたが、Excelにしろ、AccessにしろVBAではそんなのはありません。もっとも、Excelの場合は一般機能でワークシートで簡単にソートできますし、VBAでも Range.Sortで並び替えができます。また、Accessの場合は、フォームでもクエリでも OrderByでほとんど事足ります。ということでほとんど自前のソートロジックは出番がないと思いますが、なんかイレギュラーなことをやるために必要になることがあるかもしれないので？書いてみます。

アルゴリズムはクイックソートです。もうひとつのソートアルゴリズム、バブルソートに比べややこしいですが名前の通り早いのでこちらで実装します。アルゴリズム自体はググればいっぱいあるので勉強されることをお勧めします。

毎度のごとくソートを扱うクラスを作成します。このクラスは Variant型の一次元配列に対して昇順のソートを実行します。 AccessでもExcelでもいいですが、どちらかのVBエディタを起動して挿入(I)→クラスモジュール(C)で新しいクラスモジュールを作成してください。

プロパティシートでオブジェクト名をCSortに変更してください。作成したクラスモジュールに以下を記述してください。

 'CSortクラスモジュール
Option Explicit

Private vmvData As Variant

'クイックソート実行
Public Sub QuickSort()
    QSort vmvData, LBound(vmvData, 1), UBound(vmvData, 1)
End Sub

'配列argvNumの要素番号arglLeftからarglRightまでを昇順に並替え
'argvNum 並替え用配列
'arglLeft 並替えの最小要素番号
'arglRight 並替えの最大要素番号
Private Sub QSort(ByRef argvNum As Variant, ByVal arglLeft As Long, _
                                            ByVal arglRight As Long)
    Dim i        As Long
    Dim vyFlg    As Boolean   '要素内の値がすべて同じ場合はFalse
    Dim vlPivot  As Long      '軸要素
    Dim vvTmp    As Variant   '要素入れ替え時用一時変数
    Dim vlLeft   As Long      '最左要素番号保持用
    Dim vlRight  As Long      '最右

    vlPivot = argvNum(arglLeft)
    vlLeft = arglLeft: vlRight = arglRight

    '軸選定(要素内を左から順に検索して2番目に大きな値を軸とする)
    vyFlg = False
    For i = arglLeft To arglRight
        If vlPivot < argvNum(i) Then
            vlPivot = argvNum(i): vyFlg = True: Exit For
        ElseIf vlPivot > argvNum(i) Then
            vyFlg = True: Exit For
        End If
    Next i

    '要素がすべて同じ値の時は終了
    If Not vyFlg Then Exit Sub

    '並び替え
    Do While (arglLeft <= arglRight)
        Do While (arglLeft <= arglRight And vlPivot > argvNum(arglLeft))
            arglLeft = arglLeft + 1
        Loop

        Do While (arglLeft <= arglRight And vlPivot <= argvNum(arglRight))
            arglRight = arglRight - 1
        Loop

        If arglLeft > arglRight Then Exit Do

        '入れ替え
        vvTmp = argvNum(arglLeft)
        argvNum(arglLeft) = argvNum(arglRight)
        argvNum(arglRight) = vvTmp

        arglLeft = arglLeft + 1: arglRight = arglRight - 1
    Loop

    '再帰
    If vlLeft < arglRight Then QSort argvNum, vlLeft, arglRight
    If arglLeft < vlRight Then QSort argvNum, arglLeft, vlRight

End Sub

'配列取得
Public Function GetData() As Variant
    GetData = vmvData
End Function

'配列セット
Public Sub SetData(ByVal argvData As Variant)
    vmvData = argvData
End Sub

クラスモジュールに実装できたら、標準モジュールに以下を記述してCSortを使ってみます。

Public Sub test()
    Dim vvData    As Variant
    Dim voSort    As CSort
    Dim i         As Long

    Set voSort = New CSort

    voSort.SetData Array(4, 1, 0, 5, 8, 0, 3, 4, 9, 1, 3, 9)
    voSort.QuickSort

    vvData = voSort.GetData
    For i = LBound(vvData, 1) To UBound(vvData, 1)
        Debug.Print vvData(i)
    Next i

End Sub

イミディエイトウィンドウに昇順で値が出力されることを確認してください。