こんにちは、ふみです。みなさんは VBScript で1次元配列を並び替えようと思ったことはありますか？
私はプログラムで1次元配列を並び替えるときはクイックソートを良く使います。
クイックソートは1万件を超えるような配列のデータでも、ソート（データの並び替え）が速いので便利です。
今回は「クイックソート」を使って1次元配列をソートする方法ついて紹介します。
クイックソートのしくみ
クイックソートの動作のしくみは次のとおりです。
１．
配列の添字（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件と配列のソート時間（秒）がメッセージで表示されます。
解説
9行目は15行目のアスタリスク(*)以下に記載しているプロシージャを使って配列varArray を降順でソートしています。プロシージャの名前が昇順のときと変わっています。
23～24行目は不等号の向きが昇順ソートのときの逆になっています。
38行目と41行目の再帰プロシージャの名前が昇順のときと変わっています。
その他は昇順でソートするときと同じです。
まとめ
- クイックソートは同じ値を含む配列をソートした時に順番が入れ替える可能性がある（安定ソートでない）
- 1次元配列のソートは安定ソートでなくても問題ない
- クイックソートはループを2つにするとソート時間が若干早くなる
ありがとうございました。
コメント