今回はVBAでループを使った検索を高速化する方法を解説します。この記事はApplication.ScreenUpdating = Falseや配列を使ってセルの書き込み回数を減らしてもなお、For文を使ったループ検索の部分で満足できる高速化が実現できていない人を読者に想定しています。
目次
For ~ Nextステートメントによるループ検索を高速化する
この解説記事の説明の流れ（前提⇒サンプルデータの説明⇒サンプルを使った実装）
この記事では、高速化の前提を簡単に説明した後、「販売実績」の商品コードに「商品マスタ」の販売単価の情報を反映させるサンプルを使って、高速化の方法を解説します。
バイナリーサーチという検索アルゴリズムを使って高速化を行います。
高速化を試みる前に知っておきたい前提（小手先の対策と本質的な対策）
高速化の本質は余計なことはしない事です。理由はPCのスペックをプログラミングで向上させることはできないからです。処理を高速化するには余計な処理を省いて最小限のことを実行する事です。
そして余計なことを省く方法には大きく分けて2つのタイプがあります。
- 小手先の高速化
- 本質的な高速化
小手先の高速化は、Application.ScreenUpdating = False のようにいつでも簡単に使える有効な高速化の方法です。一方、本質的な高速化は場面に応じて最適な処理をプログラムで組むことです。どちらがいい、と言うわけではありません。どちらも効果はあります。しかし、小手先の高速化では限界があります。小手先の高速化の施策だけでは満足が得られず、それ以上の無駄を省く必要がある場合に本質的な高速化を目指しましょう。
本題～今回用意したサンプル～
解説のためのサンプルは「商品マスタ」と「販売実績」の2つです。いずれも大量のデータが存在します。
サンプル1ー商品マスタ
商品マスタは10437行存在します。商品コードと販売単価の2列のデータです。商品コードは「a」から始まり、0~9の数値が6桁が続く、合計7桁で構成された文字列です。商品コードに重複はありません。
販売単価は最大で4桁、最小で2桁の数値です。日本円をイメージしています。販売単価の重複はあります。
サンプル2ー販売実績ー
一方、販売実績は商品コードと販売数量が記録されています。売上高を集計するためにB列に一列手作業で挿入して、販売単価を反映させようという意図です。後工程としてはB列とC列の値をかけ算する予定です。
販売実績データはPOS*1から商品コードと販売実績数量を抜き出したデータを想定しています。
以上がサンプルデータです。やりたいことはシンプル。販売実績シートに販売単価を反映させるだけです。ただ、データ量が多いだけ。
実装
それでは実装していきます。
単なるVLOOKUP
まずは単にVLOOKUPを当てた場合です。
Sub 単なるVLOOKUP() Dim t1 As Date Dim t2 As Date Dim マスタデータの最終行 As Long '最終行取得用 Dim 販売実績データの最終行 As Long '最終行取得用 Dim 検索範囲 As Range Const データの初めの行 As Long = 2 Dim i As Long '行方向のカウントUP用 マスタデータの最終行 = Sheets("商品マスタ").Cells(Rows.Count, 1).End(xlUp).row Set 検索範囲 = Sheets("商品マスタ").Range(Cells(1, 1), Cells(マスタデータの最終行, 2)) 販売実績データの最終行 = Sheets("販売実績").Cells(Rows.Count, 1).End(xlUp).row t1 = Now 'ここからが本番 With Sheets("販売実績") For i = データの初めの行 To 販売実績データの最終行 .Cells(i, 2) = Application.WorksheetFunction.VLookup(.Cells(i, 1), 検索範囲, 2, False) Next i End With t2 = Now 'ここまでが本番 Debug.Print t2 '終了時刻 Debug.Print t1 '開始時刻 End Sub
実行に掛かった時間は47秒でした。
バイナリーサーチで高速化する
次に本格的に高速化を狙います。バイナリーサーチはデータを昇順に並び替え、データの真ん中のところで区切ります。真ん中の所の値が探している値より小さければ探している値は大きい方の半分にあるはずです。逆に真ん中の値が探している値より大きければ、小さい方の半分にあるはずです。
こうして半分に分けてどちらにあるかを繰り返していけば、いつか検索している値にたどり着く、と言うわけです。ミソは、逐次探していないところです。
文字列も不等号の演算子で大小の判定ができる事を利用します。
Sub バイナリーサーチで検索する() '下準備 Dim t1 As Date Dim t2 As Date Dim マスタデータの最終行 As Long '最終行取得用 Dim 販売実績データの最終行 As Long '最終行取得用 Const データの初めの行 As Long = 2 Dim i As Long '行方向のカウントUP用 マスタデータの最終行 = Sheets("商品マスタ").Cells(Rows.Count, 1).End(xlUp).row 販売実績データの最終行 = Sheets("販売実績").Cells(Rows.Count, 1).End(xlUp).row t1 = Now 'ここからが本番 Application.ScreenUpdating = False '>商品マスタのデータを「商品コード」をキーに昇順に並び替える Dim 商品マスタarr As Variant Sheets("商品マスタ").Activate Range(Cells(1, 1), Cells(マスタデータの最終行, 2)).Sort _ Key1:=Cells(1, 1), _ Order1:=xlAscending, _ Header:=xlYes 商品マスタarr = Range(Cells(1, 1), Cells(マスタデータの最終行, 2)) '>販売実績のシートで上から一品目ずつバイナリーサーチで検索する Dim 検索したい商品コード As String '販売実績データの商品コードを入れる Dim 低 As Long 'データの検索範囲の下限の行番号 Dim 高 As Long ' データの検索範囲の上限の行番号 Dim 中央 As Long 'データの検索範囲の真ん中の行番号 Sheets("販売実績").Activate For i = データの初めの行 To 販売実績データの最終行 '販売実績の最初から最後まで繰り返す '>>商品コードごとに初期設定 検索したい商品コード = Cells(i, 1) 低 = データの初めの行 高 = マスタデータの最終行 'ここからがバイナリーサーチの部分 Do While 低 <= 高 '下限の行と上限の行番号が一致するまでの間繰り返す 中央 = Int((低 + 高) / 2) '2で割り切れなかったら切り捨て If 商品マスタarr(中央, 1) = 検索したい商品コード Then Cells(i, 2) = 商品マスタarr(中央, 2) ',見つかったら販売単価を返す Exit Do ElseIf 商品マスタarr(中央, 1) > 検索したい商品コード Then 高 = 中央 - 1 Else 低 = 中央 + 1 End If Loop 'バイナリーサーチここまで Next i Application.ScreenUpdating = False t2 = Now 'ここまでが本番 Debug.Print t2 '終了時刻 Debug.Print t1 '開始時刻 End Sub
実行時間は9秒でした。単なるVLOOKUPの約5分の1の時間で終了することができました。
すべてSubプロシジに記述しましたが、サンプルコード内のコメントの「ここからがバイナリーサーチの部分」～「バイナリーサーチここまで」の部分をFunctionプロシジャにして分離するととてもすっきりとします。
「ここからがバイナリーサーチの部分」より前の部分は、商品マスターのデータの順番を昇順に並び替えたり配列に格納したりといった準備が長くなっています。
しかしバイナリーサーチのコードそのものは案外すっきりしていますね。
セルに値を書き込むところに時間が掛かっているので、配列の中で計算して最後にペタッとシートに戻せばさらなる高速化を図る事ができます。
高速化の本質は余計なことをしない、の感触が掴めたでしょうか。
小手先の高速化と本質的な高速化を併用して、ユーザーフレンドリーなツールに仕上げていきましょう！
＜関連記事＞
*1:販売時点データ。レジでバーコードを「ピッ」っとしたら商品コードと数量が販売実績データに蓄積される仕組み
