【VBScript】１次元配列を短時間で並び替える（クイックソート）

こんにちは、ふみです。みなさんは VBScript で1次元配列を並び替えようと思ったことはありますか？

私はプログラムで1次元配列を並び替えるときはクイックソートを良く使います。
クイックソートは1万件を超えるような配列のデータでも、ソート（データの並び替え）が速いので便利です。

今回は「クイックソート」を使って1次元配列をソートする方法ついて紹介します。

CONTENTS

1 クイックソートのしくみ
2 1次元配列を昇順に並び替える
- 2.1 サンプルコード
- 2.2 解説
3 1次元配列を降順に並び替える
- 3.1 サンプルコード
- 3.2 解説
4 まとめ

クイックソートのしくみ

クイックソートの動作のしくみは次のとおりです。

１．
配列の添字（Index）の中央値の要素を基準値にする。

２．
配列のソートする範囲の各要素を基準値と比較し、基準値より小さい要素を添字の若番側の配列、基準値より大きい要素を添字の老番側の配列に振り分ける。

３．
添字の若番側の配列と添字の老番側の配列をそれぞれ１．から始まる手順でソートする。

この手順をプログラム用に効率化したものがクイックソートのプログラムです。

クイックソートは同じ値を含む配列をソートした時に順番が入れ替える可能性があるソートです。（安定ソートではない）
しかし、1次元配列は同じ値の順番が入れ替わっても同じデータになるので、安定ソートでなくても問題がありません。

1次元配列を昇順に並び替える

1次元配列を昇順に並び替えるプログラムは次のとおりです。

サンプルコード

Option Explicit Dim varArray, sngTime, lngN ReDim varArray(49999) For lngN = LBound(varArray) To UBound(varArray)     varArray(lngN) = Int(Rnd * (UBound(varArray) + 1) * 10) Next sngTime = Timer Call QuickSort1D(varArray, LBound(varArray), UBound(varArray)) MsgBox ConfirmationTextForArray1D(varArray), , _     "Time：" & Round(Timer - sngTime, 3) & "s" WScript.Quit '****************************************************************************** '1次元配列varArray1DのlngLowerからlngUpperまでの範囲をクイックソート（昇順） Sub QuickSort1D(ByRef varArray1D, ByVal lngLower, ByVal lngUpper)     Dim varMid, varSwap, lngI, lngJ          varMid = varArray1D(Int((lngUpper + lngLower) / 2)) '添字の中央値の要素     lngJ = lngUpper     For lngI = lngLower To lngUpper         If varArray1D(lngI)>= varMid Then
            Do Until varArray1D(lngJ) <= varMid                 lngJ = lngJ - 1             Loop             If lngI>= lngJ Then
                Exit For
            Else
                varSwap = varArray1D(lngI)
                varArray1D(lngI) = varArray1D(lngJ)
                varArray1D(lngJ) = varSwap
                lngJ = lngJ - 1
            End If
        End If
    Next
    If lngLower < lngI - 1 Then
        Call QuickSort1D(varArray1D, lngLower, lngI - 1)
    End If
    If lngJ + 1  LBound(strArray1D) Then
            strTemp = strTemp & vbCrLf '改行の追加
        End If
        If c_intI >= 1 And intN >= c_intI + LBound(strArray1D) Then '上限超過時
            strTemp = strTemp & "他" & UBound(strArray1D) - (c_intI - 1)
            Exit For
        Else
            strTemp = strTemp & "配列(" & intN & ") = " & strArray1D(intN)
        End If
    Next
    ConfirmationTextForArray1D = strTemp
End Function

上記のコードを Windows 10 のアクセサリから開いたメモ帳へコピー＆ペースト後、文字コードを「ANSI」に設定し、適当なファイル名に拡張子「.vbs」をつけてデスクトップ等に保存すると、すぐに動作確認できます。
保存した vbsファイルをダブルクリックすると、要素数50,000の配列をランダムの整数値で作成後、クイックソートが行われ、昇順でソートされた配列データの若番10件と配列のソート時間（秒）がメッセージで表示されます。

解説

4～7行目は要素数50,000の配列を1～499,999の範囲のランダムの整数値で作成しています。

8行目は Timer関数でソート前の基準の秒数を取得しています。

9行目は15行目のアスタリスク(*)以下に記載しているプロシージャを使って配列varArray を昇順でソートしています。

10～11行目は44行目のアスタリスク(*)以下に記載している1次元配列のデータをメッセージ表示用の文字列で返すファンクションを使ってソート後の配列を表示すると同時に、Timer関数を使ってソート時間を表示しています。

17～43行目はクイックソートのプロシージャです。

20行目は添字の中央値の要素を基準値として取り出しています。クイックソートは基準値を要素の中央値にするのが最も効率が良く、ソート済みの配列は添字の中央値に要素の中央値が入る為、添字の中央値の要素を基準値にしています。

22～36行目のFor～Nextは添字の若番から基準値以上の要素を検出するまでループします。「クイックソート」で Google検索すると Do ～ Loop 間の中で Do ～ Loop で添字の若番から基準値以上の要素を検出後、Do ～ Loop で添字の老番から基準値以下の要素を検出する、3つのループを使ったプログラムを紹介する記事が多くみられます。しかし、1つ目の Do ～ Loop と2つ目の Do ～ Loop をこのサンプルコードのように For ～ Next でまとめるとループが2つになるので、ソート時間が若干早くなります。

24～26行目の Do ～ Loop は添字の老番から基準値以下の要素を検出しています。

27行目の条件、基準値以上の要素の添字lngI が基準値以下の要素の添字lngJ 以上になった時は配列の要素の振り分けが完了しているのでループを抜けます。
条件に一致しない時は、配列の添字lngI の要素と添字lngJ の要素を交換します。

38行目は基準値以下（または基準値より小さい）の要素数が2以上の時は、その範囲を指定して自身のプロシージャを呼び出しています。（再帰プロシージャ）

41行目は基準値以上（または基準値より大きい）の要素数が2以上の時は、その範囲を指定して自身のプロシージャを呼び出しています。

44行目のアスタリスク(*)以下に記載しているファンクションは【VBScript】プロシージャとファンクション（関数）の使い方で紹介したものを転用しています。

このクイックソートのプロシージャはExcel等の VBAでも動作しますが、VBA で使用するときは配列の引数「varArray1D」の記述を「varArray1D()」に変更すると、ソートの処理が高速化されます。

1次元配列を降順に並び替える

1次元配列を降順に並び替えるプログラムは次のとおりです。

サンプルコード

Option Explicit
Dim varArray, sngTime, lngN
ReDim varArray(49999)
For lngN = LBound(varArray) To UBound(varArray)
    varArray(lngN) = Int(Rnd * (UBound(varArray) + 1) * 10)
Next
sngTime = Timer
Call QuickReverse1D(varArray, LBound(varArray), UBound(varArray))
MsgBox ConfirmationTextForArray1D(varArray), , _
    "Time：" & Round(Timer - sngTime, 3) & "s"
WScript.Quit
'******************************************************************************
'1次元配列varArray1DのlngLowerからlngUpperまでの範囲をクイックソート（降順）
Sub QuickReverse1D(ByRef varArray1D, ByVal lngLower, ByVal lngUpper)
    Dim varMid, varSwap, lngI, lngJ
    
    varMid = varArray1D(Int((lngUpper + lngLower) / 2)) '添字の中央値の要素
    lngJ = lngUpper
    For lngI = lngLower To lngUpper
        If varArray1D(lngI) <= varMid Then             Do Until varArray1D(lngJ)>= varMid
                lngJ = lngJ - 1
            Loop
            If lngI >= lngJ Then
                Exit For
            Else
                varSwap = varArray1D(lngI)
                varArray1D(lngI) = varArray1D(lngJ)
                varArray1D(lngJ) = varSwap
                lngJ = lngJ - 1
            End If
        End If
    Next
    If lngLower < lngI - 1 Then
        Call QuickReverse1D(varArray1D, lngLower, lngI - 1)
    End If
    If lngJ + 1  LBound(strArray1D) Then
            strTemp = strTemp & vbCrLf '改行の追加
        End If
        If c_intI >= 1 And intN >= c_intI + LBound(strArray1D) Then '上限超過時
            strTemp = strTemp & "他" & UBound(strArray1D) - (c_intI - 1)
            Exit For
        Else
            strTemp = strTemp & "配列(" & intN & ") = " & strArray1D(intN)
        End If
    Next
    ConfirmationTextForArray1D = strTemp
End Function

上記のコードを Windows 10 のアクセサリから開いたメモ帳へコピー＆ペースト後、文字コードを「ANSI」に設定し、適当なファイル名に拡張子「.vbs」をつけてデスクトップ等に保存すると、すぐに動作確認できます。
保存した vbsファイルをダブルクリックすると、要素数50,000の配列をランダムの整数値で作成後、クイックソートが行われ、降順でソートされた配列データの若番10件と配列のソート時間（秒）がメッセージで表示されます。