解析エンジニアの自動化 blog

コツコツと自動化した方法を残す blog

VBA による大量データから高速検索と抽出




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


ファイル出力の記事を書きたいのですが、ファイル出力するためのテキスト処理を作成したところ、とんでもなく処理に時間がかかり、ファイル出力の前に色々と高速化について取り組んでます。

この記事では大量データから検索を行う VBA を作成して、その実行時間を検証します。
なるべく高速で検索出来るようにバイナリサーチアルゴリズムなどを調べて作成しました。

この記事では下の①〜②の実行時間を調べました。
①自作VLOOKUP関数での検索
②自作VLOOKUP関数(改)での検索




関数

検索用データ

検索を行うために Excel でテストデータを作成しました。
作成したテストデータのキャプチャ画像を図1と図2に示します。

図1 検索される配列

図2 検索する配列

また、検索される配列(図1)の"No."は昇順で飛び飛びの値としています。
"data 1"、"data 2"は乱数で適当な値としています。

また、検索する配列(図2)の"No."は使用していないので、ただのナンバリングです。
"検索値"はデータ数に基づいて変更する必要があるため、図3に示す数式を入力しました。
"data 2"は Excel の VLOOKUP 関数です。 VBA のコードが返してきた値が正しいのかを確認するために使いました。

図3 検索値の数式

自作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(2次元配列)
' 引数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(2次元配列)
' 引数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

ソースコード②の実行時間

かなりループ回数の削減が出来たようで、かなりの実行時間短縮に成功しました。実行時間をまとめた表を図4に示します。
また、実行時間をまとめたグラフを図5に示します。

図4、図5より上限行距離が小さい方が実行時間も短い結果になりました。まぁ、当たり前ですが。

図4 自作VLOOKUP関数(改)の実行時間表

図5 自作VLOOKUP関数(改)の実行時間グラフ




コメント

検索スピードを上げることは出来ました。100万行の配列からの検索でも1秒以下で値を拾い出すことができました。
しかし、上の関数では文字列の検索が出来ないので、文字列の検索が出来るようにするのが課題です。




以上