線形探索(逐次探索)と二分探索を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
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
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日
コメントで「一致する値がない場合の処理が違う」との指摘をいただき、修正しました。
コメント
このプログラムは間違えていますね。
正しくは
誤 bsearch = bsearch(goal, top, bottom – 1)
↓
正 bsearch = bsearch(goal, top, myrow – 1)
誤 bsearch = bsearch(goal, top + 1, bottom)
↓
正 bsearch = bsearch(goal, myrow + 1, bottom)
ですね。
＞橋本さん
ありがとうございます。
これだと一応、結果が出るので気付きませんでした。
後で直しておきます。
まだ、間違いがありました。
検索対象が見つからなかったとき、
検索相手の最小値より小さい場合、
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
とすれば、問題なく動作しました。
失礼しました。直した内容がなぜか変な内容となっています。
ただしくは
【改善前】
x = Cells(myrow, 1)
【改善後】
if 0<myrow then x = Cells(myrow, 1)
です。
＞橋本さん
ありがとうございます。
「変な内容」になったのは「＜」と「＞」(実際は半角)で挟んだ部分が、このブログシステム上、無視されるからかもしれません。
ご指摘いただいた点については検討させてください。