aodama.gif(0.97KB) VBでソート

 ここで言うソートとは、

    lngArray(0) = 8
    lngArray(1) = 2
    lngArray(2) = 5
のように順序がバラバラな数値を、
    lngArray(0) = 2
    lngArray(1) = 5
    lngArray(2) = 8
のように正順に整列する処理のことを言っています。 ところがVBにはソートを行う関数やメソッドなどがありません。 私が見つけていないだけかもしれませんが(^-^;
 むかしは Visual Basic増強作戦 の玉城さんが、 クイックソートのサブルーチンを公開されておられたのですが、ページを完全閉鎖されてしまったようで、 現在は閲覧することができません(泣)。
 残念ながらV増のサンプルは転載・再配布禁止なので、情報処理の参考書に載っているアルゴリズムや、 Google で見つけた C/C++ のソースなどを参考にして自分で書いてみました。

Option Explicit

'===== 基本ソートモジュール Ver 1.03 =====
'(C)2000-2002 けるべ
'MAIL : NULL
'HOME : http://www.geocities.co.jp/SilkRoad/4511/
'
'配列をソートする基本ソートアルゴリズムを VB で記述したものです。
'アルゴリズム自体はすべて情報処理の参考書などからのパクリであり、
'オリジナリティは全くありません(^^;
'
'クイックソート、バブルソート、セレクションソートの三種類の
'サブルーチンを記述していますが、処理速度が非常に高速な
'クイックソート(QuickSort)を使用することをおすすめします。

'----- QuickSort -----
'指定された配列内の要素を、クイックソートによりソートします。
'
'引数 lngArray()
'   必ず指定します。ソートを行いたい配列を指定します。例えば要素が
'       lngArray(0) = 8
'       lngArray(1) = 2
'       lngArray(2) = 5
'   の配列を渡した場合、
'       lngArray(0) = 2
'       lngArray(1) = 5
'       lngArray(2) = 8
'   のように正順に整列されます。
'
'引数 lngStart
'   必ず指定します。ソートを開始したい要素の番号を指定します。
'
'引数 lngEnd
'   必ず指定します。ソートを終了したい要素の番号を指定します。
'
'再帰的呼び出しを行う関係上、BubbleSort 関数などのように
'ソート開始・終了番号を省略することはできませんのでご注意下さい。
'
Public Sub QuickSort _
    (ByRef lngArray() As Long, _
     ByVal lngStart As Long, _
     ByVal lngEnd As Long)

 Dim lngBaseNumber As Long                                  '中央の要素番号を格納する変数
 Dim lngBaseValue As Long                                   '基準値を格納する変数
 Dim lngCounter As Long                                     '格納位置カウンタ
 Dim lngBuffer As Long                                      '値をスワップするための作業域
 Dim i As Long                                              'ループカウンタ
 
    If lngStart >= lngEnd Then Exit Sub                     '終了番号が開始番号以下の場合、プロシージャを抜ける
    lngBaseNumber = (lngStart + lngEnd) \ 2                 '中央の要素番号を求める
    lngBaseValue = lngArray(lngBaseNumber)                  '中央の値を基準値とする
    lngArray(lngBaseNumber) = lngArray(lngStart)            '中央の要素に開始番号の値を格納
    lngCounter = lngStart                                   '格納位置カウンタを開始番号と同じにする
    For i = (lngStart + 1) To lngEnd Step 1                 '開始番号の次の要素から終了番号までループ
        If lngArray(i) < lngBaseValue Then                  '値が基準値より小さい場合
            lngCounter = lngCounter + 1                     '格納位置カウンタをインクリメント
            lngBuffer = lngArray(lngCounter)                'lngArray(i) と lngArray(lngCounter) の値をスワップ
            lngArray(lngCounter) = lngArray(i)
            lngArray(i) = lngBuffer
        End If
    Next i
    lngArray(lngStart) = lngArray(lngCounter)               'lngArray(lngCounter) を開始番号の値にする
    lngArray(lngCounter) = lngBaseValue                     '基準値を lngArray(lngCounter) に格納
    Call QuickSort(lngArray(), lngStart, lngCounter - 1)    '分割された配列をクイックソート(再帰)
    Call QuickSort(lngArray(), lngCounter + 1, lngEnd)      '分割された配列をクイックソート(再帰)

End Sub

'----- BubbleSort -----
'指定された配列内の要素を、隣接交換法(バブルソート)によりソートします。
'
'引数 lngArray()
'   ソートを行いたい配列を指定します。例えば要素が
'       lngArray(0) = 8
'       lngArray(1) = 2
'       lngArray(2) = 5
'   の配列を渡した場合、
'       lngArray(0) = 2
'       lngArray(1) = 5
'       lngArray(2) = 8
'   のように正順に整列されます。
'
'引数 lngStart
'   省略可能です。ソートを開始したい要素の番号を指定します。
'   省略した場合は引数 lngArray() の最小要素番号からソートを行います。
'
'引数 lngEnd
'   省略可能です。ソートを終了したい要素の番号を指定します。
'   省略した場合は引数 lngArray() の最大要素番号までソートを行います。
'
Public Sub BubbleSort _
    (ByRef lngArray() As Long, _
     Optional ByVal lngStart As Long, _
     Optional ByVal lngEnd As Long)

 Dim i As Long                                              'ループカウンタ
 Dim j As Long                                              'ループカウンタ
 Dim w As Long                                              '作業域
 
    If Not CBool(lngStart) Then lngStart = LBound(lngArray) '開始要素番号が指定されていない場合、最小要素番号を求める
    If Not CBool(lngEnd) Then lngEnd = UBound(lngArray)     '終了要素番号が指定されていない場合、最大要素番号を求める
    If lngStart >= lngEnd Then Exit Sub                     '終了要素番号が開始要素番号以下の場合、プロシージャを抜ける
    
    i = lngEnd
    Do Until i <= lngStart
        j = lngStart
        Do Until j >= i
            If lngArray(j) >= lngArray(j + 1) Then
                w = lngArray(j)
                lngArray(j) = lngArray(j + 1)
                lngArray(j + 1) = w
            End If
            j = j + 1
        Loop
        i = i - 1
    Loop

End Sub

'----- SelectionSort -----
'指定された配列内の要素を、選択交換法(セレクションソート)により
'ソートします。
'
'引数 lngArray()
'   ソートを行いたい配列を指定します。例えば要素が
'       lngArray(0) = 8
'       lngArray(1) = 2
'       lngArray(2) = 5
'   の配列を渡した場合、
'       lngArray(0) = 2
'       lngArray(1) = 5
'       lngArray(2) = 8
'   のように正順に整列されます。
'
'引数 lngStart
'   省略可能です。ソートを開始したい要素の番号を指定します。
'   省略した場合は引数 lngArray() の最小要素番号からソートを行います。
'
'引数 lngEnd
'   省略可能です。ソートを終了したい要素の番号を指定します。
'   省略した場合は引数 lngArray() の最大要素番号までソートを行います。
'
Public Sub SelectionSort _
    (ByRef lngArray() As Long, _
     Optional ByVal lngStart As Long, _
     Optional ByVal lngEnd As Long)

 Dim i As Long                                              'ループカウンタ
 Dim j As Long                                              'ループカウンタ
 Dim w As Long                                              '作業域
 
    If Not CBool(lngStart) Then lngStart = LBound(lngArray) '開始要素番号が指定されていない場合、最小要素番号を求める
    If Not CBool(lngEnd) Then lngEnd = UBound(lngArray)     '終了要素番号が指定されていない場合、最大要素番号を求める
    If lngStart >= lngEnd Then Exit Sub                     '終了要素番号が開始要素番号以下の場合、プロシージャを抜ける
    
    i = lngStart
    Do Until i >= lngEnd
        j = i + 1
        Do Until j > lngEnd
            If lngArray(i) > lngArray(j) Then
                w = lngArray(i)
                lngArray(i) = lngArray(j)
                lngArray(j) = w
            End If
            j = j + 1
        Loop
        i = i + 1
    Loop

End Sub

サンプル : ダウンロード sort.lzh(5.42KB)

 この三種類のソートアルゴリズムの処理速度を計測してみました。 クイックソート速すぎます(^^;

 要素数 10 個とか、要素数が少ない配列ならバブルソート・セレクションソートの方が速いかもしれませんが、 さすがに処理時間計測は不可能でした。 よっぽどのことがない限り、クイックソートを使用することをおすすめします。
ソート処理速度比較

 このサンプルでは長整数型(Long)配列のソートしかできませんが、 少し改造すれば Single, Double 型などのソートも簡単にできます。 改造例をアップしておきました。

倍精度浮動小数点型(Double)配列のソート - ダウンロード dblsort.txt (2.49KB)
可変長文字列型(String)配列のソート - ページを表示 文字列のソート
VBScript でソート - ページを表示 VBScript でクイックソート


VBコーナーにもどる   トップページにもどる