VBA による大量データから高速検索と抽出
こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。
![[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]](https://hbb.afl.rakuten.co.jp/hgb/18787d09.d9eb760d.18787d0a.5af71c27/?me_id=1203677&item_id=10425943&m=https://thumbnail.image.rakuten.co.jp/@0_mall/soukai/cabinet/78/4971650800578.jpg?_ex=80x80&pc=https://thumbnail.image.rakuten.co.jp/@0_mall/soukai/cabinet/78/4971650800578.jpg?_ex=240x240&s=240x240&t=picttext "[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]")
この記事の目次
目的
ファイル出力の記事を書きたいのですが、ファイル出力するためのテキスト処理を作成したところ、とんでもなく処理に時間がかかり、ファイル出力の前に色々と高速化について取り組んでます。
この記事では大量データから検索を行う VBA を作成して、その実行時間を検証します。
なるべく高速で検索出来るようにバイナリサーチのアルゴリズムなどを調べて作成しました。
この記事では下の①〜②の実行時間を調べました。
①自作VLOOKUP関数での検索
②自作VLOOKUP関数(改)での検索
関数
検索用データ
検索を行うために Excel でテストデータを作成しました。作成したテストデータのキャプチャ画像を図１と図２に示します。
また、検索される配列（図１）の"No."は昇順で飛び飛びの値としています。
"data 1"、"data 2"は乱数で適当な値としています。
また、検索する配列（図２）の"No."は使用していないので、ただのナンバリングです。
"検索値"はデータ数に基づいて変更する必要があるため、図３に示す数式を入力しました。
"data 2"は Excel の VLOOKUP 関数です。 VBA のコードが返してきた値が正しいのかを確認するために使いました。
自作VLOOKUP関数
単純に For 〜 Next で配列を検索して、同一値が有ったら任意の列の値を返す関数です。ソースコード①
〜自作VLOOKUP関数〜
Sub 自作関数でVLOOKUP()
' 検索されるデータ数
' この設定を 10,000 ～ 1,000,000 まで変更した
データ数 = ThisWorkbook.Sheets("検索用データ").Cells(3, 10).Value
' 検索するデータ数
繰り返し数 = 500
' 開始時刻の記録
開始時刻 = Time
' 検索される配列の取得
With ThisWorkbook.Sheets("検索用データ")
検索される配列 = .Range(.Cells(4, 2), .Cells(4 + データ数 - 1, 4))
End With
' 検索する値の取得
With ThisWorkbook.Sheets("検索用データ")
検索する配列 = .Range(.Cells(4, 7), .Cells(4 + 繰り返し数 - 1, 7))
End With
getColumn = 3 ' 抽出する配列の列番号
' メモリ上の配列に対する VLOOKUP 実行
For i = LBound(検索する配列) To UBound(検索する配列)
ret = VLOOKUP4ARRAY2perfect(検索する配列(i, 1), 検索される配列, getColumn)
Next i
' 終了時刻の記録
終了時刻 = Time
' プログラムの実行時間を計算
実行時間 = DateDiff("s", 開始時刻, 終了時刻)
' 実行時間をイミディエイトウィンドウに出力
Debug.Print "データ数: " & データ数 & vbNewLine & _
"Start: " & 開始時刻 & vbNewLine & _
"End: " & 終了時刻 & vbNewLine & _
"実行時間: " & 実行時間 & " sec" & vbNewLine
End Sub
'------------------------------------------------------------------------------
' 引数1：定数1
' 引数2：配列1(２次元配列)
' 引数3：定数2
' 動作:引数2の配列で引数1と同一値を検索して引数3の配列値を返す。
'------------------------------------------------------------------------------
Function VLOOKUP4ARRAY2perfect(ByVal SearchKey, ByRef ArrTarget, ByVal getColumn)
' そもそも検索する値が数値でないといけない関数なので、型変換
If IsNumeric(SearchKey) And SearchKey <> "" Then
SearchKey = Val(SearchKey)
Else
VLOOKUP4ARRAY2perfect = ""
End If
' 配列の先頭列をスキャン
For i = LBound(ArrTarget, 1) To UBound(ArrTarget, 1)
' 配列の先頭列が SearchKey と同一の場合は配列の getColumn を返す
If Val(ArrTarget(i, LBound(ArrTarget, 2))) = SearchKey Then
VLOOKUP4ARRAY2perfect = ArrTarget(i, getColumn)
Exit For
End If
DoEvents
Next i
End Function
ソースコード①の実行時間
検索に時間がかかり過ぎて、中断しました。何か手を加えないとソースコード①は使い物になりませんでした。自作VLOOKUP関数(改)
『高速検索 アルゴリズム』でネット検索して、色々見て見たんですが『バイナリサーチ』というアルゴリズムを参考に改造しました。大まかに言うと、検索する値が検索される配列のどこら辺にあるかを計算して、 For 〜 Next する範囲を小さくする処理を追加しました。
どこまで範囲を小さくするかの閾値として『上限行距離』という変数を作成しました。
この変数は配列のα行〜β行の範囲に検索する値があるとした時、α〜β行が何行あるかを計算し、上限行距離の行数より小さければ For 〜 Next で値を抽出するという具合に使っています。
ソースコード②
〜自作VLOOKUP関数(改)〜
Sub 自作関数でVLOOKUP改()
' 検索されるデータ数
' この設定を 10,000 ～ 1,000,000 まで変更した
データ数 = ThisWorkbook.Sheets("検索用データ").Cells(3, 10).Value
' 検索するデータ数
繰り返し数 = 500
' 開始時刻の記録
開始時刻 = Time
' 検索される配列の取得
With ThisWorkbook.Sheets("検索用データ")
検索される配列 = .Range(.Cells(4, 2), .Cells(4 + データ数 - 1, 4))
End With
' 検索する値の取得
With ThisWorkbook.Sheets("検索用データ")
検索する配列 = .Range(.Cells(4, 7), .Cells(4 + 繰り返し数 - 1, 7))
End With
getColumn = 3 ' 抽出する配列の列番号
' メモリ上の配列に対する VLOOKUP 実行
For i = LBound(検索する配列) To UBound(検索する配列)
ret = FastVLOOKUP4ARRAY2perfect(検索する配列(i, 1), 検索される配列, getColumn)
Next i
' 終了時刻の記録
終了時刻 = Time
' プログラムの実行時間を計算
実行時間 = DateDiff("s", 開始時刻, 終了時刻)
' 実行時間をイミディエイトウィンドウに出力
Debug.Print "データ数: " & データ数 & vbNewLine & _
"Start: " & 開始時刻 & vbNewLine & _
"End: " & 終了時刻 & vbNewLine & _
"実行時間: " & 実行時間 & " sec" & vbNewLine
End Sub
'------------------------------------------------------------------------------
' 引数1：定数1
' 引数2：配列1(２次元配列)
' 引数3：定数2
' 動作:引数2の配列で引数1と同一値を検索して引数3の配列値を返す。
'------------------------------------------------------------------------------
Function FastVLOOKUP4ARRAY2perfect(ByVal SearchKey, ByRef ArrTarget, ByVal getColumn)
' 配列の分布を調べる
最小行 = LBound(ArrTarget, 1)
最小値 = Val(ArrTarget(LBound(ArrTarget, 1), LBound(ArrTarget, 2)))
中央行 = Val((UBound(ArrTarget, 1) + LBound(ArrTarget, 1)) / 2)
中央値 = Val(ArrTarget(中央行, LBound(ArrTarget, 2)))
最大行 = UBound(ArrTarget, 1)
最大値 = Val(ArrTarget(UBound(ArrTarget, 1), LBound(ArrTarget, 2)))
' ループ回数の上限
' この設定を 5 ～ 5,000 まで変更した
上限行距離 = ThisWorkbook.Sheets("検索用データ").Cells(3, 12).Value
' そもそも検索する値が数値でないといけない
If IsNumeric(SearchKey) And SearchKey <> "" Then
SearchKey = Val(SearchKey)
Else
FastVLOOKUP4ARRAY2perfect = ""
End If
Area検索:
If 中央値 <= SearchKey Then
距離 = 最大行 - 中央行
If 上限行距離 <= 距離 Then
最小行 = 中央行
最小値 = Val(ArrTarget(最小行, LBound(ArrTarget, 2)))
最大行 = 最大行
最大値 = Val(ArrTarget(最大行, LBound(ArrTarget, 2)))
中央行 = Val((最大行 + 最小行) / 2)
中央値 = Val(ArrTarget(中央行, LBound(ArrTarget, 2)))
DoEvents
GoTo Area検索:
Else
昇順 = SearchKey - 中央値
降順 = 最大値 - SearchKey
If 昇順 >= 降順 Then
スタート = 最大行
エンド = 中央行
更新 = -1
Else
スタート = 中央行
エンド = 最大行
更新 = 1
End If
End If
ElseIf 中央値 > SearchKey Then
距離 = 中央行 - 最小行
If 上限行距離 <= 距離 Then
最小行 = 最小行
最小値 = Val(ArrTarget(最小行, LBound(ArrTarget, 2)))
最大行 = 中央行
最大値 = Val(ArrTarget(最大行, LBound(ArrTarget, 2)))
中央行 = Val((最大行 + 最小行) / 2)
中央値 = Val(ArrTarget(中央行, LBound(ArrTarget, 2)))
DoEvents
GoTo Area検索:
Else
昇順 = SearchKey - 最小値
降順 = 中央値 - SearchKey
If 昇順 >= 降順 Then
スタート = 中央行
エンド = 最小行
更新 = -1
Else
スタート = 最小行
エンド = 中央行
更新 = 1
End If
End If
End If
' 配列の先頭列をスキャン
For i = スタート To エンド Step 更新
' 配列の先頭列が SearchKey と同一の場合は配列の getColumn を返す
If Val(ArrTarget(i, LBound(ArrTarget, 2))) = SearchKey Then
FastVLOOKUP4ARRAY2perfect = ArrTarget(i, getColumn)
Exit For
End If
DoEvents
Next i
End Function
ソースコード②の実行時間
かなりループ回数の削減が出来たようで、かなりの実行時間短縮に成功しました。実行時間をまとめた表を図４に示します。また、実行時間をまとめたグラフを図５に示します。
図４、図５より上限行距離が小さい方が実行時間も短い結果になりました。まぁ、当たり前ですが。
コメント
検索スピードを上げることは出来ました。100万行の配列からの検索でも１秒以下で値を拾い出すことができました。
しかし、上の関数では文字列の検索が出来ないので、文字列の検索が出来るようにするのが課題です。
以上
