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
|