|
▼わいわい さん:
こんばんは。
実は最近同じようなの作っていたので。
こんな感じのです。で、わいわいさんのソースのほうが
シンプルでいいなっと見ていたらきづいただけですけどね^^;
あ、こちらこそ、宜しくお願いします。
Sub main()
Dim SearChIndex As Integer
Dim firstAddress As Integer
Dim SearchRange As Range
'B列の検索
With ActiveSheet.Range("B:B")
'検索
Set SearchRange = .Find("*" & "M6" & "*", LookIn:=xlValues)
'検索の文字が見つかった
If Not SearchRange Is Nothing Then
'最初に見つかったセル位置確保(同じ検索繰り返し防止)
firstAddress = SearchRange.Address
Do
'見つかった行位置確保(これはセルに書き込むための確保)
SearChIndex = SearchRange.Row
'見つかったので見つかったセル行の2列目に書き込むかっと。
ActiveSheet.Cells(SearChIndex, 2) = "変更"
'次の検索へ
Set SearchRange = .FindNext(SearchRange)
'まだ次の行がある
If Not SearchRange Is Nothing Then
'次の行はもしかして最初の検索だったりする?
If (SearchRange.Address = firstAddress) Then
'んじゃ終る
Exit Do
End If
End If
Loop While Not SearchRange Is Nothing
End If
End With
End Sub
|
|