t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA 線形探索(リニアサーチ)と二分探索(バイナリーサーチ)

Excelのある列からVBAで値を探す方法はいくつかある。

今回はこのようにExcelの全行に値を敷き詰めて、それを検索してみようと思う。
f:id:t-hom:20151205074258p:plain

探すもなにも、そのまま行番号なのだが、VBAでの検索用サンプルとして大量の値が欲しかったのでこれで妥協することにした。

線形探索

まずいちばん簡単なのは、ループで頭から順に見ていくやり方だ。
これを線形探索(せんけいたんさく)と呼ぶ。英語でLinear search(リニアサーチ)とも。

Sub 線形探索()
    探し物 = 999999
    For i = 1 To Rows.Count
        If Cells(i, 1).Value = 探し物 Then
            Debug.Print "発見しました!位置("; Cells(i, 1).Address(False, False); ")"
            Exit Sub
        End If
    Next
    Debug.Print "見つかりませんでした。"
End Sub

今回のサンプルでは全行なので100万件あるが、それでも4~5秒で完了する。
つまり10万件なら0.4秒、1万件なら0.04秒ということ。
普通はこれで十分である。

二分探索

とはいってもスピードに拘りたい場合もある。
そんなときは、二分探索(にぶんたんさく)がおススメである。英語でBinary search(バイナリ―サーチ)とも。
ただし、この方法は探索範囲が昇順にソートされていないと使えない。

Sub 二分探索()
    探し物 = 1000000
    ここから = 1
    ここまで = Rows.Count + 1 'プラス1しておかないと、最終値が取れない。
    Do
        If 真ん中 = ここから + ((ここまで - ここから) \ 2) Then
            'このIf文は、代入式(A)と同じ内容なので、
            '成立するならば、「真ん中」は前周と変化なしということ。
            'したがって探索範囲も変化していない。
            'つまりこのまま継続すると無限ループに陥るため、
            Debug.Print "みつかりませんでした。" 'と表示させて
            Exit Do 'する。
        End If
        
        真ん中 = ここから + ((ここまで - ここから) \ 2) '(A)
        If Cells(真ん中, 1).Value > 探し物 Then
            ここまで = 真ん中
        ElseIf Cells(真ん中, 1).Value < 探し物 Then
            ここから = 真ん中
        Else
            Debug.Print "発見しました!位置("; Cells(真ん中, 1).Address(False, False); ")"
            Exit Do
        End If
    Loop
End Sub

このコードが何をやっているかというと、ちょうど辞書から単語を探すときのように探している値が中央より前にあるか後ろにあるかを判定し、探索範囲を半分→半分→半分と絞り込んでいる。
真ん中で二分割されるから二分探索である。

処理速度に関して

数秒の処理が1瞬になったところで、大して変わらないと思うかもしれない。
長い一日の中で数秒の節約なんて、かき集めてもたかだか数分程度にしかならないだろう。
しかしこれは、時間効率だけを考えた話だ。

人間は、ほんの数秒の待ち時間でも結構イライラするものだ。
Webページの読み込みが2秒遅れるだけで、サイトから立ち去る人が50%も増加したという話もあるそうだ。
web-tan.forum.impressrd.jp

スピードは快適さである。打てば響くレスポンスの良いシステムは、使っていて気持ちが良い。
テンポよく快適に仕事を進めるという意味では、処理速度は極めて重要な要素だと思う。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。