線形探索と二分探索をVBAで

Pocket

線形探索(逐次探索)と二分探索をVBA(Excel)で行う方法です。
それぞれサンプルを示します。
ここではExcelのシートのA列の1行から40行まで昇順の数値が入っている場合に、ある数値を探し、その行番号を表示することにします。

線形探索

線形探索(逐次探索)は、端から順番に探していき、見つかったら終わりという方法です。
データが2倍になると探索にかかる時間も2倍になります。

Sub 線形探索()
    Const maxrow = 40
    res = InputBox("値")
    v = CInt(res)
    r = 0
    Do
        r = r + 1
    Loop Until Cells(r, 1) = v Or maxrow < r
    If r > maxrow Then
        MsgBox "見つかりません"
    Else
        MsgBox r & "行目です"
    End If
End Sub

二分探索

二分探索は、値が昇順(または降順)になっている場合に使える方法です。
まず先頭と末尾の中央にある値を取り出して比較します。
一致したならば終わりです。
一致しない場合は中央値が大きい場合はそれより前にあるはずなので、先頭と中央の一つ前で同じことをします。
中央値が小さい場合はそれより後にあるはずなので、中央の一つ後と末尾で同じことをします。
これを一致するまで繰り返します。
データが2倍になっても探索にかかる時間は2倍にならず繰り返し回数が1回増える程度です。

Sub 二分探索()
     Const maxrow = 40
     res = InputBox("値")
     v = CInt(res)
     MsgBox bsearch(v, 1, maxrow)
End Sub
Function bsearch(goal, top, bottom)
     If top > bottom Then
         bsearch = "見つかりません"
         Exit Function
     End If
     myrow = Int((top + bottom) / 2)
     x = Cells(myrow, 1)
     If x = goal Then
         bsearch = myrow & "行目です"
     ElseIf goal < x Then
         bsearch = bsearch(goal, top, myrow - 1)
     Else
         bsearch = bsearch(goal, myrow + 1, bottom)
     End If
End Function

2016年2月18日
コメントで「一致する値がない場合の処理が違う」との指摘をいただき、修正しました。

[ 2011年7月6日 | カテゴリー: Excel | タグ: , ]

« | »

コメント

  1. 橋本毅(たけし) より:

    このプログラムは間違えていますね。

    正しくは

    誤 bsearch = bsearch(goal, top, bottom – 1)
            ↓
    正 bsearch = bsearch(goal, top, myrow – 1)

    誤 bsearch = bsearch(goal, top + 1, bottom)
            ↓
    正 bsearch = bsearch(goal, myrow + 1, bottom)

    ですね。

  2. stabucky より:

    >橋本さん
    ありがとうございます。
    これだと一応、結果が出るので気付きませんでした。
    後で直しておきます。

  3. 橋本毅 より:

    まだ、間違いがありました。
    検索対象が見つからなかったとき、
    検索相手の最小値より小さい場合、
    myrowが0となるため、 x = Cells(myrow, 1) でCellの添え字が0でエラーとなります。
    つまり、添え字が0より大きいときのみ、xにcell値を格納すれば問題ないかと思います。
    【現状】
    myrow = Int((top + bottom) / 2)
    x = Cells(myrow, 1)
    If top > bottom Then
    bsearch = “見つかりません”
    ElseIf x = goal Then
    bsearch = myrow & “行目です”
    ElseIf goal < x Then
    bsearch = bsearch(goal, top, myrow – 1)
    Else
    bsearch = bsearch(goal, myrow + 1, bottom)
    End If

    【改善後】
    myrow = Int((top + bottom) / 2)
    if 0 bottom Then
    bsearch = “見つかりません”
    ElseIf x = goal Then
    bsearch = myrow & “行目です”
    ElseIf goal < x Then
    bsearch = bsearch(goal, top, myrow – 1)
    Else
    bsearch = bsearch(goal, myrow + 1, bottom)
    End If
    とすれば、問題なく動作しました。

  4. 橋本毅 より:

    失礼しました。直した内容がなぜか変な内容となっています。
    ただしくは
    【改善前】
    x = Cells(myrow, 1)
    【改善後】
    if 0<myrow then x = Cells(myrow, 1)
    です。

  5. stabucky より:

    >橋本さん
    ありがとうございます。
    「変な内容」になったのは「<」と「>」(実際は半角)で挟んだ部分が、このブログシステム上、無視されるからかもしれません。
    ご指摘いただいた点については検討させてください。

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

送信してください。


タグ

カテゴリー

最近の投稿

最近のコメント

固定ページ

アーカイブ

stabucky

写真

メタ情報