Excelマクロであるセル条件を検出、他の決められたセルに色を付けたい

質問

Excelマクロであるセル条件を検出、他の決められたセルに色を付けたい　その2
例えば、エクセルのあるセルに"A"が書かれていた場合、次にその列のセルに"A"書かれているまでは、続く列のセルには色をつけるようにしたいのですが、良い方法を教えて頂けないでしょうか？

対象となるシート（列方向）に、今回のパターンが複数存在し、
それぞれにこの処理を実施することを想定しております。

（イメージ画像を添付します）

回答No.3

jcctaira · ベストアンサー

Sub 背景色付け()
　Const 条件文字 = "A"
　Const 背景色 = 35
　Dim セル範囲 As Range
　Dim 条件範囲 As Range
　Dim C As Integer
　Dim R As Integer

　Set セル範囲 = Range("A1", Cells.SpecialCells(xlCellTypeLastCell))
　For C = 1 To セル範囲.Columns.Count
　　　Set 条件範囲 = Nothing
　　　For R = 1 To セル範囲.Rows.Count
　　　　　If Cells(R, C) = 条件文字 Then
　　　　　　　If 条件範囲 Is Nothing Then
　　　　　　　　　Set 条件範囲 = Cells(R, C)
　　　　　　　Else
　　　　　　　　　Set 条件範囲 = Range(条件範囲, Cells(R, C))
　　　　　　　　　条件範囲.Interior.ColorIndex = 背景色
　　　　　　　　　Set 条件範囲 = Nothing
　　　　　　　End If
　　　　　End If
　　　Next R
　Next C
End Sub

お礼

ありがとうございました！
ほぼ、やりたかったことがほぼできるようになりました。
感謝しております。

回答No.2

KURUMITO

例えば次のようなマクロのコードにします。

Sub 範囲に色を付ける()

Dim RowPos As Integer
Dim ColPos As Integer
Dim RowPos1 As Integer

RowPos = 11
Do
RowPos = RowPos + 1
If WorksheetFunction.CountIf(Range(Cells(RowPos, "A"), Cells(RowPos, "F")), "A") > 0 Then
For ColPos = 1 To 6
If Cells(RowPos, ColPos).Value = "A" Then
RowPos1 = RowPos
Do
RowPos1 = RowPos1 + 1
If Cells(RowPos1, ColPos).Value = "A" Then
Range(Cells(RowPos, ColPos), Cells(RowPos1, ColPos)).Interior.ColorIndex = 8
End If
If RowPos1 > Range("A65536").End(xlUp).Row Then Exit Do
Loop Until Cells(RowPos1, ColPos).Value = "A"
End If
Next
RowPos = RowPos1
End If
Loop Until RowPos = Range("A65536").End(xlUp).Row

End Sub

お礼

丁寧なご指導ありがとうございました。
申し訳ありませんが、私には、No3様の回答の方が判りやすかったので、
あちら様を良回答とさせて頂きました。
ご了承ください。

回答No.1

D-Matsu

各列のrangeに対するfindで、検索パターンをxlWhole(完全一致)にした上で「奇数回目のヒット」と「偶数回目のヒット」の間を塗る、という方法でいいんじゃないでしょうか。
別にベタにやってもいいとは思いますが、こっちの方が手間は少ないかと。

補足

早速の回答ありがとうございます。

申し訳ありませんが、当方VBAに明るくありません。
大変お手数ですが、簡単なサンプルコードを示して頂ければ幸いなのですが、
お願いできないでしょうか。