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

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

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


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


[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

菊正宗 日本酒の化粧水 高保湿(500mL)
価格:816円(税込、送料別) (2019/5/18時点)



この記事の目次




目的


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

この記事では大量データから検索を行う 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秒以下で値を拾い出すことができました。
しかし、上の関数では文字列の検索が出来ないので、文字列の検索が出来るようにするのが課題です。




以上