vbaで条件付き書式を設定したときの適用範囲について

vbaについて詳しくないのですが、ご相談させてください。

条件付き書式をvbaにて設定しようとして、その適用先（適用範囲）がずれてしまっているのですが、現在のマクロの記述のどこが原因なのでしょうか。

Excelにてプライベートの出納帳を作成しており、支払方法（プルダウンリストから選択）によって、同じ行の関連項目のセルをまとめて色付けしようとしています。（条件付き書式は手動でもできますが、勉強と手抜きを兼ねてvbaで設定しようとしています。）

出納帳には各日付ごとに「支払方法」、「品名」、「金額」のセルがあり、
これが1日～31日まで続いています。
（支払方法で「クレカ①」を設定すれば、同じ行にある同じ日付のこれら3列分の項目のテキストが色付けされる。）

R列（18列目）～T列（20列目）　⇒1日
U列（21列目）～W列（23列目）　⇒2日
：
DA列（105列目）～DC列（107列目）　⇒30日
DD列（108列目）～DF列（110列目）　⇒31日

これを同じ日付では一つの条件付き書式を設定したい（=18列目から3列ごとに条件付き書式を設定し、各書式の設定範囲は3列分としたい）のですが、適用先が上手く反映されません。

このマクロの実行後の条件付き書式の設定を確認すると、「適用先」が思うようになっていません。
「ルール」の$R8,$U8,$X8,…は自分が設定したかったルールになっているのですが、
「適用先」はそれぞれ自分が設定したかった=$R$8:$T$49,=$U$8:$W$49,=$X$8:$Z$49,という適用先からずれてしまっています。

コードは以下の通りです。自分なりにwebで調べた中で継ぎ接ぎしたものですが、「適用先」の修正ができれば、自分がやりたいことはできると考えています。

駄文ですが、お詳しい方がいらっしゃいましたら、お力添えいただけないでしょうか。

Sub 条件付き書式_支払方法()
Dim Row_Start As Long
Dim Row_Last As Long
Dim Line_Start As Long
Dim i As Long

Row_Start = 8
Line_Start = 18

For i = 0 To 108 Step 3

Row_Last = Cells(Rows.Count, 8).End(xlUp).Row

If Range(Cells(Row_Start, Line_Start + i), Cells(Row_Last, LineStart + i + 2)).FormatConditions.Count <> 0 Then
Range(Cells(Row_Start, Line_Start + i), Cells(Row_Last, LineStart + i + 2)).FormatConditions.Delete
End If

Dim exp As String

exp = Cells(Row_Start, Line_Start + i).Address(0, 1)

With Range(Cells(Row_Start, Line_Start + i), Cells(Row_Last, LineStart + i + 2)).FormatConditions.Add(Type:=xlExpression, Formula1:="=" & exp & "=""クレカ①""")
.Font.ThemeColor = xlThemeColorAccent5
.StopIfTrue = False
End With

Next
End Sub

No.1 ベストアンサー 回答者： fujillin 回答日時： 2023/07/18 01:39

こんばんは

レイアウトが3列ずつでセットになっていて、
その1列目（Ｒ列、Ｕ列・・）の値が「クレカ①」だったら、その行の3列分に書式を適用したいということと解釈しました。

＞という適用先からずれてしまっています
原因はご提示のコードで（多分）変数の記述ミスが数か所あることだと思います。
例えば、
＞Range(Cells(Row_Start, Line_Start + i), Cells(Row_Last, LineStart + i + 2))
後半のCellの列数の変数がみな LineStart となっていますが、間違えでは？

なお、ご質問には直接関係ありませんが・・
＞For i = 0 To 108 Step 3
ご説明文だと、設定対象はDF列（＝120列）まででよいはずですが、上記だと128列目まで設定されます。
（多分、条件がTRUEにはならないので、余分に設定したからと言って問題はないのでしょうけれど）

また、ループの中で
＞Row_Last = Cells(Rows.Count, 8).End(xlUp).Row
を繰り返していますが、値は変わらないので、ループ外で一度計算しておけば済みます。
あるいは、各列の最終行を都度求めようとしているのであれば、列が変数になっていないとおかしいです。


上記で、多分修正可能と思いますけれど、少し発想を変えてまとめて処理してしまう例を、ご参考までに記載しておきます。

※ 設定する行の範囲が49で固定なのか可変なのかよくわかりませんけれど、使いそうな行までまとめて設定しても構わなければ固定値で大きめの値にしておけばよさそうに思います。

Sub Sample()
Const f = "=OFFSET(R8,,-MOD(COLUMN(),3))=""クレカ①"""
Const n = 49 ' ←使用想定最大行番号（可変にするなら計算で求める）

With Range("R8:DF8").Resize(n - 7).FormatConditions
.Delete
.Add Type:=xlExpression, Formula1:=f
.Item(1).Font.ThemeColor = xlThemeColorAccent5
.Item(1).StopIfTrue = False
End With
End Sub

この回答へのお礼

ご指摘いただいた箇所の修正で、思うような書式設定にできました。

Sub 修正_条件付き書式_支払方法()
Dim Row_Start As Long
Dim Row_Last As Long
Dim Line_Start As Long
Dim i As Long

Row_Start = 8
Line_Start = 18

Row_Last = Cells(Rows.Count, 8).End(xlUp).Row

For i = 0 To 90 Step 3

If Range(Cells(Row_Start, Line_Start + i), Cells(Row_Last, Line_Start + i + 2)).FormatConditions.Count <> 0 Then
Range(Cells(Row_Start, Line_Start + i), Cells(Row_Last, Line_Start + i + 2)).FormatConditions.Delete
End If

Dim exp As String

exp = Cells(Row_Start, Line_Start + i).Address(0, 1)

With Range(Cells(Row_Start, Line_Start + i), Cells(Row_Last, Line_Start + i + 2)).FormatConditions.Add(Type:=xlExpression, Formula1:="=" & exp & "=""クレカ①""")
.Font.ThemeColor = xlThemeColorAccent5
.StopIfTrue = False
End With

Next
End Sub

ただ、参考例の方が条件付き書式も1個で済みますね。
modを上手く使うんですね。

行数は可変・固定どちらでも構わないのですが、今回は参考例を使おうと思います。

どうもありがとうございました！

お礼日時：2023/07/20 22:02