こんばんは、
前回の回答では3個目は黄色に戻ってしまい、申し訳なかったです。m(_ _)m
Sub Test5()
Dim fnd As Range, R As Boolean, c As Boolean
Dim adr As String, keyWord As String
keyWord = Range("P1").Value
Range("A1:N10").Interior.Color = xlNone
Set fnd = Range("A1:N10").Find(What:=keyWord, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=True)
If fnd Is Nothing Then
MsgBox keyWord & " は見つかりませんでした。", 48
Exit Sub
End If
adr = fnd.Address
Do
R = fnd.Row Mod 2 = 0
c = fnd.Column Mod 2 = 0
With fnd.Offset(R, c).Resize(2, 2).Interior
If .Color = vbYellow Then
.Color = vbRed
ElseIf .Color = vbRed Then
.Color = vbGreen
ElseIf .Color = vbGreen Then
.Color = vbBlue
ElseIf .Color = vbWhite Then
.Color = vbYellow
End If
End With
Set fnd = Range("A1:N10").FindNext(fnd)
Loop While adr <> fnd.Address
End Sub
お礼
いつも回答頂きありがとうございます。 早速、教えて頂きありがとうござます。 前回の回答の動作には気が付きませんでした。 また質問を見かけたらよろしくお願いします。 丸投げですが・・・。