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