エクセル条件付き書式をマクロにしたいです

質問

Ｅｘｃｅｌ２００７使用しています。
類似質問が見つかりましたが、ＶＢＡ勉強中でそこからの応用ができないので
教えていただけると助かります。

条件付き書式を毎回作成するのが大変なので、マクロで自動設定したいと考えています。
条件付き書式で設定していたのは「C4に指定文字があったら、B4・C5・D4・E4のセルを指定した色に塗りつぶす」を5パターン使用していました。

色を変えるかどうか判断する文字が含まれているのはC列にあります。

C4に「ああ」の文字があればB4・C5・D4・E4のセルを赤色に塗りつぶす
C4に「いい」の文字があればB4・C5・D4・E4セルをアクア色に塗りつぶす
C4に「うう」の文字があればB4・C5・D4・E4セルを黄色に塗りつぶす
C4に「ええ」の文字があればB4・C5・D4・E4セルをオリーブ色に塗りつぶす
C4に「おお」の文字があればB4・C5・D4・E4セルを紫色に塗りつぶす
これを、C4から文字がある行まで（200行～15,000行まで対象行数が変動）処理して欲しい

イメージで伝えて申し訳ありません、
情報足りなければご指摘いただければと思います。

どうぞ宜しくお願い申し上げます。

回答No.3

mitarashi · ベストアンサー

#2です。冷静になって考えると、大げさな事をしているので、もっと素直なコードに変更いたしました。これで、明日の自分にも分かり易くなります。データ消滅のリスクも無くなりました。

Sub test()
Dim myCell As Range, targetRange As Range

With Sheets(1)
Set targetRange = Range(.Range("C4"), .Range("C" & .Rows.Count).End(xlUp))
End With
For Each myCell In targetRange.Cells
Call test3(myCell, myCell.Offset(0, 1))
Call test3(myCell, myCell.Offset(0, 2))
Call test3(myCell, myCell.Offset(0, -1))
Call test3(myCell, myCell.Offset(1, 0))
Next myCell
End Sub

Sub test3(srcCell As Range, destCell As Range)
Dim conditionArea As Range, myRow As Range
Dim myFormulaR1C1 As String, myFormula1 As String
Dim myCondition As FormatCondition
Const formulaTemplate As String = "=R[○]C[□]"

Set conditionArea = Sheets(2).Range("A1").CurrentRegion.Resize(, 2)
destCell.FormatConditions.Delete
myFormulaR1C1 = Replace(formulaTemplate, "○", CStr(srcCell.Row - destCell.Row))
myFormulaR1C1 = Replace(myFormulaR1C1, "□", CStr(srcCell.Column - destCell.Column))
myFormulaR1C1 = Replace(myFormulaR1C1, "[0]", "") '無くても可。自動的に消される。

For Each myRow In conditionArea.Rows
'文字列が対象
myFormula1 = myFormulaR1C1 & "=""" & myRow.Cells(1).Value & """"
With destCell
Set myCondition = .FormatConditions.Add(Type:=xlExpression, Formula1:=myFormula1)
'.FormatConditions(.FormatConditions.Count).SetFirstPriority '優先順の正逆切り替え
myCondition.Interior.Color = myRow.Cells(2).Interior.Color
myCondition.StopIfTrue = False 'お好みで
End With
Next myRow
End Sub

なお、#2の図のD列は、適当な式・値を入れて復旧されるかどうか確認したものです。

お礼

ご返答ありがとうございました、
図もつけていただきどういった操作命令なのかイメージできました。
私の使い方がダメなのか、操作が上手く反映されないのですが
教えていただいた内容を理解して実際の運用までつなげていきます。
ご協力助かります、ありがとうございました。

回答No.2

mitarashi

#1さんのご回答で実用上はOKなのでしょうが、文字通り「条件付き書式のマクロでの設定」を試してみました。汎用化しようとすると結構骨でした。
当方xl2010です。添付画像の様な理解として、とりあえず動きましたが、R1C1形式の式を生成するために、元データを一旦待避して書き戻す処理をしていますので、試す際はかならずバックアップを取ってからお願いします。
なお、xl2007は環境がありませんので、もし動かなくても対応できない場合もありますが悪しからず。
処理対象は1番目のシートで、2番目のシートにルール設定の条件と色を設定するものとします。test()を実行して下さい。
注）対照表を毎回取得する非効率な事をしていますが、コードの簡便さを優先しています。また、文字での判断を前提としています。

Sub test()
Dim myCell As Range, targetRange As Range

With Sheets(1)
Set targetRange = Range(.Range("C4"), .Range("C" & .Rows.Count).End(xlUp))
End With
For Each myCell In targetRange.Cells
Call test2(myCell, myCell.Offset(0, 1))
Call test2(myCell, myCell.Offset(0, 2))
Call test2(myCell, myCell.Offset(0, -1))
Call test2(myCell, myCell.Offset(1, 0))
Next myCell
End Sub

Sub test2(srcCell As Range, destCell As Range)
Dim conditionArea As Range, myRow As Range
Dim myFormulaR1C1 As String, myFormula1 As String
Dim oldFormula As Variant

Set conditionArea = Sheets(2).Range("A1").CurrentRegion.Resize(, 2)

destCell.FormatConditions.Delete
oldFormula = destCell.Formula
destCell.Formula = "=" & srcCell.Address(False, False, xlA1)
myFormulaR1C1 = destCell.FormulaR1C1
destCell.Formula = oldFormula

For Each myRow In conditionArea.Rows
myFormula1 = myFormulaR1C1 & "=""" & myRow.Cells(1).Value & """"
With destCell
.FormatConditions.Add Type:=xlExpression, Formula1:=myFormula1
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).Interior.Color = myRow.Cells(2).Interior.Color
.FormatConditions(1).StopIfTrue = False
End With
Next myRow
End Sub

お礼

2投稿いただきありがとうございます、
すみませんそんなに大変なこととは知らず安易に質問してしまいました…
申し訳ありませんでした。
ご丁寧にありがとうございます。

回答No.1

tsubuyuki

ごくごく単純に考えてみました。

Sub test()
　　For i = 4 To Cells(Rows.Count, 3).End(xlUp).Row　' ４から「Ｃ列の最終行まで」

　　Select Case Cells(i, 3).Value　　　'ｉ行目３列目（Ｃ列）の値で分岐
　　　　Case "ああ"　　　　　　　　　　' 値が"ああ"の時は
　　　　　　Cells(i, 2).Interior.Color = RGB(0, 0, 255)　　' ｉ行目Ｂ列を青塗りつぶし
　　　　　　Cells(i + 1, 3).Interior.Color = RGB(0, 0, 255) ' i+1行目Ｃ列を（略）

　　　　Case "いい"　　　　　　　　　　' 以下同文につき省略
　　　　　　Cells(i, 2).Interior.Color = RGB(255, 0, 255)

　　　　Case "うう"
　　　　　　Cells(i, 2).Interior.Color = RGB(255, 255, 0)

　　　　Case "ええ"
　　　　　　Cells(i, 2).Interior.Color = RGB(0, 255, 255)

　　　　Case "おお"
　　　　　　Cells(i, 2).Interior.Color = RGB(255, 0, 0)

　　　　End Select
　　Next
End Sub

塗潰すセル番地は"ああ"のように列記してあげてください。
色は・・適当ですので、お好みの色に設定し直してくださいね。

今回はSelect Case～を使いましたが、If～Thenを重ねても同様にできます。
この辺は好みで使い分けましょう。

ただ正直、
> 条件付き書式を毎回作成するのが大変なので
マクロを組む方が大変だと思いますよ＾＾；

お礼

コメントが遅れて申し訳ありませんでした、早速ありがとうございます！
マクロ勉強不足と言う前にマクロで組むことが大変なのですね…
お手間をおかけしてしまいすみません、
それでも回答くださって感謝です！