特定の値のセルのRangeオブジェクトの取得

VBA

特定のセルを２分探索で取得するのを書いたのでメモ。
（いらないのも交じってますが・・・）

Sub キー値取得()
'２分探索でキーのセルを探索
'オーダーは件数/ 2

Dim tempoCode As Long  '店舗コード
Dim kamokuCode As Long '科目コード
Dim kamokuCount As Long '勘定科目数
Dim uniquekey As Range 'ユニークキーの基準セル
Dim uniquekeyCode As String    '探したい店舗キー＋科目コード（ユニークキー）

Dim uniqueMinCell As Range          '探索用変数
Dim uniqueMaxCell As Range          '探索用変数
Dim uniqueNowCell As Range          '探索用変数
Dim uniqueMax As Long               '探索用
Dim uniqueMin As Long               '探索用
Dim uniqueNow As Long               '探索用
Dim uniqueNowColumn As Long  '探索用変数
Dim uniqueNowCount As Long   '探索用変数

'初期化
tempoCode = 3000 '店舗コード設定
kamokuCode = 1003 '科目コード設定
kamokuCount = 72    '現在の科目数を設定


Set uniquekey = Range("AU2")  'ユニークキーの基準セルの設定

uniquekeyCode = CStr(tempoCode) + CStr(kamokuCode) '探すユニークキーの設定

Set uniqueMinCell = uniquekey                                       '最初の最小値を設定
'Debug.Print TypeName(uniquekey.CurrentRegion.Rows.Cells)           '保護をかけていると取得できない？

'暫定的にこちらを使用
Set uniqueMaxCell = Cells(41, "AU")                                 '最初の最大値を設定
'Set uniqueMaxCell = Cells(uniquekey.CurrentRegion.Rows.Cells.Count, "AU")  '最初の最大値を設定　？(CurrentRegion.Rows.Cells.countが574を返す)

Set uniqueNowCell = Cells(CInt(uniqueMaxCell.Row / uniqueMinCell.Row), "AU")

'２分探索で処理
'キーとの差が１０になるまで探索
Do Until uniquekeyCode = uniqueNowCell.Value
    If (uniquekeyCode > uniqueNowCell.Value) Then
        Set uniqueMinCell = Cells(CInt(uniqueNowCell.Row), "AU")
        Set uniqueNowCell = Cells(CInt((uniqueMaxCell.Row + uniqueMinCell.Row) / 2), "AU")
        Debug.Print uniqueNowCell.Row
        Debug.Print uniqueMinCell.Row
        Debug.Print uniqueMaxCell.Row
    'キーが下位場合
    ElseIf (uniquekeyCode < uniqueNowCell.Value) Then
        Set uniqueMaxCell = Cells(CInt(uniqueNowCell.Row), "AU")
        Set uniqueNowCell = Cells(CInt((uniqueMaxCell.Row + uniqueMinCell.Row) / 2), "AU")
        Debug.Print uniqueNowCell.Row
        Debug.Print uniqueMinCell.Row
        Debug.Print uniqueMaxCell.Row
    End If
Loop

'Debug.Print uniquekeyCode
'Debug.Print uniqueNowCell.Value

'ループで1件ずつ検索
'処理が重すぎるので使用しない
'For i = 1 To uniquekeyColumn.CurrentRegion.Rows.Count
'    If Cells(i, "AU").Value = uniquekeyCode Then
'        Cells(uniquekeyColumn.CurrentRegion.Rows.Count + 1, "AU").Value = Cells(i, "AU").Value
'        Cells(uniquekeyColumn.CurrentRegion.Rows.Count, "B").Value = Cells(i, "B").Value
'        Cells(uniquekeyColumn.CurrentRegion.Rows.Count, "D").Value = Cells(i, "D").Value
'        Cells(uniquekeyColumn.CurrentRegion.Rows.Count, "AT").Value = Cells(i, "AT").Value
'        Exit For
'    End If
'Next i

End Sub