前回、[Excel VBA] 特定条件を満たすセルを見つけるにて特定のセルを見つける方法を記載したが、問題が見つかった。
そこで、その問題に対策を施したバージョンをご紹介する。
Excel で以下の様な番号と名前のデータがあったときに、番号をキーにして名前を取得するようなことは多いだろう。
このようなケースを処理するためには、Find メソッドを使用するとうまくできる。

前回の方法では Loop 条件式で Not c Is Nothing と判断している。
これは、Do ～ Loop 内で検索対象セルが1件も存在しない状況になったときに有効だが、現在の VBA の仕様では完全論理比較を行うので、正常に処理ができない。
また、1件も存在しない場合には、ループに入る前に If 文で判定するのでこの条件式は不要だった。
今回はこの問題に対応している。

※1 番号は書式指定で "0000" とし、 1 を 0001 としている

たとえば、番号 "0003" の田中さんを取得したい場合には以下のように処理をする。

Function CellAddress(c As Range) As String
    CellAddress = ""
    If Not c Is Nothing Then CellAddress = c.Address
End Function

Sub 番号3番の田中さんを見つける()
    Const NameCol = 1
    Dim SearchArea As Range             ' 検索範囲
    Dim c As Range                      ' 検索結果
    Dim firstAddress As String          ' 最初に見つかったセルのアドレス
    
    ' 検索範囲
    With ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion
        Set c = .Columns(1).Find(3)     ' 検索範囲の最初のカラムから番号を検索
        firstAddress = c.Address    ' 最初のアドレスを覚えておく ※2
        Do
            MsgBox .Cells(c.Row, NameCol), vbOKOnly, "発見"
            Set c = .FindNext
        Loop While (CellAddress(c) <> firstAddress)
    End With
End Sub

※2 同じ番号が複数回出現するなどでループにて処理を行う場合、最後のセルの次を検索すると最初のセルが見つかる。
このため、最初に見つかったセルのアドレスを覚えておく必要がある。 この方法で、検索を行うと if 文を利用して検索するよりも断然早く処理を完了させることができる。
また、見つかったデータを削除するようなケースでは、以下のように処理を行う。

Sub 見つけた番号3番の田中さんを全て削除する()
    Const NameCol = 1
    Dim SearchArea As Range             ' 検索範囲
    Dim c As Range                      ' 検索結果
    Dim firstAddress As String          ' 最初に見つかったセルのアドレス
    
    ' 検索範囲
    With ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion
        Set c = .Columns(1).Find(3)     ' 検索範囲の最初のカラムから番号を検索
        Do
            Rows(foundRow).Delete 
            Set c = .FindNext
        Loop While Not c Is Not Nothing
    End With
End Sub

削除処理の場合は、見つかったデータ全てを削除していくので、最初に見つかったセルのアドレスを覚える必要がない。