Excel VBA:特定範囲を特定の値で検索した結果をRangeオブジェクトで返す関数

今回はExcel VBAの小ネタを１つ。

Excelマクロでセルの検索をしようとしていらついたことはないだろうか。

例えば特定の範囲でセルの値が"X"であるセルを検索したいとする。

ちょっとググってみると、FindとFindNextを使ってやればよい、とわかる。

ところが、これって結構面倒。

最初にFind関数で検索して、2回目以降FindNextで検索して、1回目と同じアドレスかどうかチェックして。。

　　：

そこで、ですよ。

特定の範囲と検索値を引数でコールすると、検索値にマッチする範囲を返すような関数があれば便利じゃない。

そこで、さらにググると。。

英語サイトだが、いいのがあった。

http://www.ozgrid.com/forum/showthread.php?t=27240

Find_Range関数、というのが公開されている。

Unionを使って上手にまとめている。

この関数がめっちゃ便利。

返り値の型がRangeオブジェクトなので検索したセルに色をつけたり、セル数数えたり、となんでもできる。

もちろん検索する値は文字列でもかまわない。

使用例として挙げられているのは、こんな感じ。

値が22のセルを選択するコード例:

Find_Range(22, Range("D10:G20")).Select

値が999のセルをクリアするコード例：

Find_Range(999, Range("D10:G20"), xlFormulas, xlWhole).ClearContents

A列で値が"X"のセルの行を削除するコード例：

Find_Range("X", Columns("A"), MatchCase:=True).EntireRow.Delete

シート全体で値が1000のセルの行を選択するコード例：

Find_Range(1000, Cells, xlFormulas, xlWhole).EntireRow.Select

D列で値が1000のセルを含む行全体をSheet2にコピーするコード例：

Find_Range(1000, Columns("D"), xlFormulas, xlWhole).EntireRow.Copy Range("Sheet2!A1")

オレサマが多用するのはこんな感じ。

Set FoundRange = Find_Range("X", Range( ... ), xlFormulas, _
                            xlPart, MatchCase:=True, MatchByte:=True)
If Not FoundRange Is Nothing Then
  For Each c In FoundRange
    処理
    ：
  Next
End If

もちろん、引数の"Range( … )"の部分はRangeオブジェクトならなんでもよい。

詳細は上のURLで飛んでみてもらえばよいのだが、公開されているコードは検索時に全角/半角を区別することができない。

そこだけちょこっと変えたのが以下のコードである。

Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As XlFindLookIn = xlValues, _
    Optional LookAt As XlLookAt = xlPart, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte As Boolean = True) As Range
    
    Dim c As Range, FirstAddress As String
    
    With Search_Range
        Set c = .Find( _
        What:=Find_Item, _
        LookIn:=LookIn, _
        LookAt:=LookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=MatchCase, _
        MatchByte:=MatchByte, _
        SearchFormat:=False) 'Delete this term for XL2000 and earlier
        If Not c Is Nothing Then
            Set Find_Range = c
            FirstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
End Function

Excel2000以前の場合、特に97とかだとだめらしい。

この辺は、上記URLに詳述されているので参考にしてほしい。

※こちらに具体例とかを補足しました。