日々是好日

プログラミングについてのあれこれ、ムダ知識など

二分探索を VBA で実装してみた

「アッ二分探索木(バイナリサーチ)実装してみたい!再帰的に!!」

ってふと思い立ったので、 2 日かけて書いてみた。我ながら変態かよ。

まともに再帰的なコード書いたのは初めてくらい。 どう実装に落とし込むのかの理解がムズカシカッタ。。。

一応条件。

  • 諸事情により VBA
  • 使うセルはWorksheets("Sheet1")の A列 のみ
  • A列 に昇順で適当な値を入れておく(リストの代わり)
  • 出力値は、探索値が入ってるセルの行番号(A50のセルで見つければ50が出力)
  • 値が見つからなければ-1を出力
Option Explicit

Dim sh As Worksheet
Dim target As Integer

Sub startSearch()

    target = 'ここに探索する値をベタ打ち'

    Set sh = ThisWorkbook.Worksheets("Sheet1")

    Dim result As Integer
    Dim maxRow As Integer
    maxRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
    result = binarySearch(getNextPoint(1, maxRow), 1, maxRow)
    Debug.Print ("row: " & result)

    Set sh = Nothing

End Sub

Function binarySearch(pointer As Integer, imin As Integer, imax As Integer)

    If imax - imin = 1 Then
        binarySearch = -1
    ElseIf sh.Cells(pointer, 1).Value < target Then
        binarySearch = binarySearch(getNextPoint(pointer, imax), pointer, imax)
    ElseIf sh.Cells(pointer, 1).Value > target Then
        binarySearch = binarySearch(getNextPoint(imin, pointer), imin, pointer)
    Else
        binarySearch = pointer
    End If

End Function

Function getNextPoint(imin As Integer, imax As Integer) As Integer

    Debug.Print ("imin: " & imin & ", imax: " & imax)
    getNextPoint = imin + WorksheetFunction.RoundDown((imax - imin) / 2, 0)

End Function

取り急ぎ投稿したくなったので、後で肉付けする←←