マージソートとは何か？を理解できます。
マージソートのアルゴリズムをVBAで実現しています。
数値、日付の配列を高速でソートして配列で返します。
コピペするだけで使用できるようになります。
昇順降順対応しています。
こんにちは、hokkyokunです。
アルゴリズムについて学習していきたいと思います。
アルゴリズムはプログラミングをするうえで確実にレベルを上げてくれる大事な概念なので、
頑張って一緒に勉強しましょう！！
前回、再帰的定義をまとめ、再帰関数を使えるようになりました。
まだ、ご覧になってない方はぜひ見ていってください。
さて、今回はアルゴリズムを使って、
ソート（並び替え）を実装していきたいと思います。
プログラムでとても大事な概念である配列ですが、
VBAの配列は結構足りないところが多く。。。
配列内ソートもできません。これがめちゃくちゃ不便。。
まじめな話、VBAの評判を落としている原因の何％かは配列の仕様じゃないかと思ってます。
今回は配列のソートをマージソートというアルゴリズムを使って実装したいと思います。
マージソートとは
概念
マージとは結合を指し、
コードを書いた人であれば、データの結合なので、一度は耳にしたことがあると思います。
マージソートはその名の通り、
数値の集合（今後は配列と呼びます）を分解して、並び替えをし、再結合させて値を返す手法です。
もう少し詳しく、かつプログラムっぽい言い換えにしてみます。
処理は以下の二工程に分割できます。
- 配列を二分割にする処理
ｋ個の要素を持つ配列を、ｋ/2個の要素になるように配列Ａ、配列Ｂに格納する
配列Ａと配列Bを要素数が1になるまで分解する。 - 分割した配列をソートして結合する処理
配列Aと配列Bを比較し、より小さい値から順に格納する（ソート）
配列Aと配列Bを結合して、戻り値として返す
図で書くとこんな感じ
文字で書いてもよくわからないので、図式化します。
配列を二分割にした処理
分割した配列をソートして結合する処理
上記の結合処理（マージ処理）は
左の配列と右の配列を要素を比較して、
昇順になるようにソート処理をします。
例えば、④は左の配列（3 , 6）と右の配列（1 , 2 , 7 )を比較して、
（ 1 , 2 , 3 , 6 , 7）となるようにします。
これを図示すると、
となります。
ちなみに左の配列および右の配列はそれぞれの結合段階で比較して結合しているので、
配列内は必ず昇順になっています。
マージソートをVBAでコード化
では、実際にコードをVBAで書いてみます。
上記でもあるように
- 配列を二分割にする処理
- 分割した配列をソートして結合する処理
を分けて考えます。
配列を二分割にする処理
Function merge_Operation(arrs As Variant)
'配列を二分割する。左(Larrs)と右(Rarrs)で便宜上命名
Dim Larrs(), Rarrs() As Variant
Dim m As Long '配列の真ん中を整数で取得
Dim i As Long '二分割した後の配列(Larrs,Rarrs)に格納するためのインデックス
Dim Li As Long 'Larrsに格納する値をarrsで指定するためのインデックス
Dim Ri As Long 'Rarrsに格納する値をarrsで指定するためのインデックス
If UBound(arrs) <= 0 Then
'分割前の配列が最大要素が0以下(=要素数1以下)になったら終了
'再帰関数の出口＝これがないと多分エラーで止まる(か、無限ループ？）
merge_Operation = arrs
Else
'要素数を2で割った商から1引く
m = (UBound(arrs) + 1) \ 2 - 1
'元の配列(arrs)の要素から、0～m(要素数の真ん中)までの要素をLarrsに格納
i = 0
For Li = 0 To m
ReDim Preserve Larrs(i)
Larrs(i) = arrs(Li)
i = i + 1
Next Li
'元の配列(arrs)の要素から、m+1～最後までの要素をRarrsに格納
i = 0
For Ri = m + 1 To UBound(arrs)
ReDim Preserve Rarrs(i)
Rarrs(i) = arrs(Ri)
i = i + 1
Next Ri
'再帰処理
Call merge_Operation(Larrs)
Call merge_Operation(Rarrs)
End If
End Function試しにこの関数を動かしてみます。
以下のプロシージャで動かしてみます。
Sub test2()
Dim arrs() As Variant
arrs = Array(6, 3, 7, 2, 1)
Call merge_Operation(arrs)
Stop
End Sub実際にやってみるとわかるのですが、
上の関数 ( merge_Operation ) の37行目の再帰処理前で
stopを入れてみてください
プログラムを動かすと下記のように
再帰処理が図で示したように処理されていきます。
分割した配列をソートして結合する処理
Function Merge(Larrs As Variant, Rarrs As Variant)
Dim Li As Long '左側の配列(Larrs)のインデックス
Dim Ri As Long '右側の配列(Rarrs)のインデックス
Dim Ai As Long '結合後の配列のインデックス
Dim arrs() As Variant '結合後の配列
Dim num As Double '結合後の配列に格納する要素を入れる
Dim i As Long '残っている要素を一気に格納するためのインデックス
'結合するために二つの配列を用意する。
'便宜上、左側の配列（以下Larrs)と右側の配列(以下Rarrs)と命名する。
'LarrsとRarrsの要素を比較し、小さいものを結合後の配列(以下arrs)に格納する
'LarrsとRarrsの要素どちらも残っている場合、
'要素を比較して小さい方をarrsに格納する。
'入れた方の配列はインデックスを＋1する。
Do While (Li <= UBound(Larrs)) And (Ri <= UBound(Rarrs))
If Larrs(Li) >= Rarrs(Ri) Then
num = Rarrs(Ri)
Ri = Ri + 1
Else
num = Larrs(Li)
Li = Li + 1
End If
ReDim Preserve arrs(Ai)
arrs(Ai) = num
Ai = Ai + 1
Loop
'Larrsに要素が残っていたら、処理
If Li <> UBound(Larrs) + 1 Then
For i = Li To UBound(Larrs)
ReDim Preserve arrs(Ai)
arrs(Ai) = Larrs(i)
Ai = Ai + 1
Next i
End If
'Rarrsに要素が残っていたら、処理
If Ri <> UBound(Rarrs) + 1 Then
For i = Ri To UBound(Rarrs)
ReDim Preserve arrs(Ai)
arrs(Ai) = Rarrs(i)
Ai = Ai + 1
Next i
End If
Merge = arrs
End FunctionこれもSubプロシージャで試してみます。
左の配列（＝Larrs : ( 3 , 6 )) と 右の配列(=Rarrs : ( 1 , 2 , 7 ))
を結合させ、配列(=arrs : ( 1 , 2 , 3 , 6 , 7))が返ってくれば成功です。
Sub test3()
Dim Larrs(), Rarrs() As Variant
Dim arrs As Variant
Larrs() = Array(3, 6)
Rarrs() = Array(1, 2, 7)
arrs = Merge(Larrs, Rarrs)
End Sub
期待通りの結果が返ってきました。
完成したプログラム
お待たせしました。
以上をもとにコピペで使える関数を公開します。
基本的には上記と変えていませんが、
昇順降順に対応できるように引数を増やし、
昇順の場合と降順の場合で処理を分けるよう分岐させています。
また、merge_OperationとMergeの連携が取れるように微妙に内容を変えていたり、
名前を変えたりしています。
コード
Function merge_Sort_for_Int(arrs As Variant, asc As Boolean)
'配列を二分割する。左(Larrs)と右(Rarrs)で便宜上命名
Dim Larrs(), Rarrs() As Variant
Dim m As Long '配列の真ん中を整数で取得
Dim i As Long '二分割した後の配列(Larrs,Rarrs)に格納するためのインデックス
Dim Li As Long 'Larrsに格納する値をarrsで指定するためのインデックス
Dim Ri As Long 'Rarrsに格納する値をarrsで指定するためのインデックス
If UBound(arrs) <= 0 Then
'分割前の配列が最大要素が0以下(=要素数1以下)になったら終了
'再帰関数の出口＝これがないと多分エラーで止まる(か、無限ループ？）
merge_Sort_for_Int = arrs
Else
'要素数を2で割った商を1引く
m = (UBound(arrs) + 1) \ 2 - 1
'Larrsへの格納処理
'元の配列(arrs)の要素から、0～m(要素数の真ん中)までの要素をLarrsに格納
i = 0
For Li = 0 To m
ReDim Preserve Larrs(i)
Larrs(i) = arrs(Li)
i = i + 1
Next Li
'Rarrsへの格納処理
'元の配列(arrs)の要素から、m+1～最後までの要素をRarrsに格納
i = 0
For Ri = m + 1 To UBound(arrs)
ReDim Preserve Rarrs(i)
Rarrs(i) = arrs(Ri)
i = i + 1
Next Ri
'再帰処理
Larrs = merge_Sort_for_Int(Larrs, asc)
Rarrs = merge_Sort_for_Int(Rarrs, asc)
merge_Sort_for_Int = merge_for_Int(Larrs, Rarrs, asc)
End If
End Function
Function merge_for_Int(Larrs As Variant, Rarrs As Variant, asc As Variant)
Dim Li As Long '左側の配列(Larrs)のインデックス
Dim Ri As Long '右側の配列(Rarrs)のインデックス
Dim Ai As Long '結合後の配列のインデックス
Dim arrs() As Variant '結合後の配列
Dim num As Double '結合後の配列に格納する要素を入れる
Dim i As Long '残っている要素を一気に格納するためのインデックス
'結合するために二つの配列を用意する。
'便宜上、左側の配列（以下Larrs)と右側の配列(以下Rarrs)と命名する。
'LarrsとRarrsの要素を比較し
'昇順の場合 ⇒ 小さいものを結合後の配列(以下arrs)に格納する
'降順の場合 ⇒ 大きいものを結合後の配列(以下arrs)に格納する
'入れた方の配列はインデックスを＋1する。
'どちらかの配列の要素がすべてなくなったら残りの要素をすべてarrsに格納する
'昇順の場合
If asc = True Then
Do While (Li <= UBound(Larrs)) And (Ri <= UBound(Rarrs))
If Larrs(Li) >= Rarrs(Ri) Then
num = Rarrs(Ri)
Ri = Ri + 1
Else
num = Larrs(Li)
Li = Li + 1
End If
ReDim Preserve arrs(Ai)
arrs(Ai) = num
Ai = Ai + 1
Loop
'降順の場合
Else
Do While (Li <= UBound(Larrs)) And (Ri <= UBound(Rarrs))
If Larrs(Li) <= Rarrs(Ri) Then
num = Rarrs(Ri)
Ri = Ri + 1
Else
num = Larrs(Li)
Li = Li + 1
End If
ReDim Preserve arrs(Ai)
arrs(Ai) = num
Ai = Ai + 1
Loop
End If
'Larrsに要素が残っていたら、残りをarrsに全部格納
If Li <> UBound(Larrs) + 1 Then
For i = Li To UBound(Larrs)
ReDim Preserve arrs(Ai)
arrs(Ai) = Larrs(i)
Ai = Ai + 1
Next i
End If
'Rarrsに要素が残っていたら、残りをarrsに全部格納
If Ri <> UBound(Rarrs) + 1 Then
For i = Ri To UBound(Rarrs)
ReDim Preserve arrs(Ai)
arrs(Ai) = Rarrs(i)
Ai = Ai + 1
Next i
End If
merge_for_Int = arrs
End Function使い方
めっちゃ長いですね。
コードを短くすることはできるかもしれないですが、
少なくとも私はこれくらい丁寧にやった方が後々可読性が保たれる気がします。
基本的にmerge_Sort_for_Int関数に二つの引数を入れて使用します。
第一引数 ： ソート前の配列。Variant型
第二引数 ： 昇順降順の指定。Boolean型
昇順 ⇒ True
降順 ⇒ False
コードの流れですが、
- ソート前の配列をmerge_Sort_for_Int関数の第一引数に入れます。
第二引数にブール型を入れて、昇順か降順かを指定します。 - merge_Sort_for_Int関数内で再帰処理が行われます。
- 引数に指定した配列の最大インデックス（Ubound(arrs))が0以下になる
＝分解が最後まで行くと、再帰処理は終了します。 - 次にmerge_for_Int関数が二つの配列を引数とし、
その二つの配列の要素数を、昇順もしくは降順になるようにソートをかけ、結合します。 - 最後にすべての配列を一つに集約し、昇順もしくは降順になった配列を戻り値として返します。
実際に使ってみましょう
さて、これもSubプロシージャでテストしてみましょう。
1.昇順と降順でソート
以前に作った、乱数を発生させる関数を使用しています。
詳しくは、こちらにあります。よかったら見てください！！
Sub test()
Dim arrs As Variant '乱数を配列に格納
Dim arrs_ascending As Variant '昇順ソートをかける
Dim arrs_decending As Variant '降順ソートをかける
arrs = get_Random(10, 1, 100)'乱数を生成（詳しくはブログ見てください！）
arrs_ascending = merge_Sort_for_Int(arrs, asc:=True)
arrs_decending = merge_Sort_for_Int(arrs, asc:=False)
Stop
End Sub動かしてみた結果はこんな感じです。
昇順と降順にソートできていますね。
2.時間計測
時間計測も仕込んでみました。
Sub test２()
Dim start_, end_ As Date '時間計測
Dim arrs() As Variant
Dim results, result As Variant
start_ = Now
arrs = get_Random(100, 1, 1000) '乱数を発生させる関数（詳しくはブログ見てね！）
results = merge_Sort_for_Int(arrs, True)
Debug.Print "開始" & Now
For Each result In results
Debug.Print result
Next
end_ = Now
Debug.Print Format(end_ - start_, "hh:nn:ss")
End Sub時間計測しましたが、要素数、100くらいなら、0秒。
1,000で、イミディエイトにデバッグさせて1秒（させなければ0秒）
処理で固まるのが500,000くらいからです（これで20秒くらい）
大きなデータを扱うのでなければ、ほぼランタイムはなしと考えてよさそうです。
さらに勉強したいかた
いかがだったでしょうか。
ここまで作るのにかなり頭をすり減らしました。。。
参考にしたのは、米田優峻さんの書籍です。
今回紹介したマージソートの他にも
いろいろとアルゴリズムを紹介してくれているので、ぜひ勉強してみてください。
VBAについては
こちらがおすすめです。覚えたての頃これで勉強しました。
今でも辞書的にたまに見返したりします。
配列がソートできると世界が変わる
仰々しいかもですが、本気でそう感じる面がVBAにはあります。
私はPythonとVBAくらいしか知らないのですが、
VBAがちょっとなー。。と思われる点の何％かは配列の弱さにあると思います。
- 要素数を宣言、再宣言しないと格納できない
- 配列と配列を結合できない
- そして配列内ソートができない。
一方で、配列のソートができるようになると、
辞書やコレクションのソートができるようになります。
辞書のソートができるようになるとユニークリストを作成し、それを整列させるなど、
事務系業務の幅はめちゃくちゃあがります。
配列内ソート、ぜひぜひ使ってみてください。
そして、よかったら、アルゴリズムを一緒に勉強しましょう！！
ではでは。
