Find&FindNextでデータを検索する
 Find&FindNextを使う際には、最終行まで検索が終了したら先頭から
また検索を開始するため、なんらかのフラグをたてる必要があるという点に
注意しましょう。
 次のサンプルマクロでは、最初に見つけた行番号と同じ(つまり同じセル)
になったらループを抜けるようにしています。

Sub Sample()

    Dim rngCell  As Range
    Dim StartRow As Variant
    Dim i        As Integer
    Dim noRow    As Integer
    Dim strConfirm(1000) As String

    Set rngCell = Columns(1).Find("コメント")
    StartRow = rngCell.Row

    While Not StartRow = noRow
        Set rngCell = Columns(1).FindNext(after:=rngCell)
        noRow = rngCell.Row
        strConfirm(i) = rngCell.Value
        MsgBox strConfirm(i) & ":" & i + 1 & "個目発見!"
        i = i + 1
    Wend

End Sub

 次のサンプルマクロでは、選択範囲を検索し、セルに色を付けています。

Sub Sample()

    Dim oRange As Range
    Dim r As Range
    Dim sWhat As String
    Dim iRow As Long, iColumn As Long
    Dim iCount As Long

    sWhat = "コメント"
    Set oRange = Selection
    iCount = 0

    With oRange.Areas(oRange.Areas.Count)
        Set r = .Cells(.Cells.Count)
    End With

    '1件目の検索
    Set r = oRange.Find(what:=sWhat, after:=r, _
        LookIn:=xlValues, LookAt:=xlWhole, _
        searchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, MatchByte:=True)

    If Not (r Is Nothing) Then

        '最初のセルの行と列を保存
        iRow = r.Row
        iColumn = r.Column

        '処理を繰り返す
        Do

            iCount = iCount + 1
            r.Interior.ColorIndex = 3

            '次の検索
            Set r = oRange.FindNext(after:=r)
        Loop Until (r.Row = iRow) And (r.Column = iColumn)
    End If

    MsgBox CStr(iCount) & "個のセルを処理しました。"

End Sub

Excel97



戻る


Excel Word Access VBA! モーグ