条件付書式のVBA

質問

条件付書式のVBAについて質問させてください。
A1:A100に「晴れ」「曇り」「雨」「台風」「不明」と入力するとします、するとその行のいくつかセルに色をつけたいです。
たとえば、A1に「晴れ」と入力されたらB1、C1、（D1とばして）E1、F1・・・に色がつく。

できればVBAの式を教えていただけると大変助かります。
どうぞよろしくお願いいたします。

回答No.8

n-jun · ベストアンサー

ANo.7です。

>入力列がA列ではなくてL列になってしまったのですが、、、（泣）
>If　.Column　<>　1　Then　Exit　Subを
>If　.Column　<>　12　Then　Exit　Subにしてみたりしたのですが。。。（違ってますね。。。）
方法はあってますよ。

ただし、Ｌ列に対して元々の【B1、C1、（D1とばして）E1、F1】が変更ないのであれば、
With　.Range("B1:C1,E1:F1")　'Ｅ列以降はどこまで？
だとＬ列を基準に右列を塗りつぶしますので、
With Range("B1:C1,E1:F1").Offset(.Row - 1) 'Ｅ列以降はどこまで？
に変更して下さい。

お礼

出来ました！！本当に本当にお手を煩わせてしまって申し訳ございませんでした。
本当に助かりました。

少しでも自分でも勉強して行こうと思いますがまた何かありましたらよろしくお願いします！

回答No.7

n-jun

ANo.6です。

>やはり何度設定しても、A列に「晴れ」と記入しても色は変わらず、
>マクロをあえて手で実行しないと指定のセルに色がつかないようです。。。
標準モジュールですから上記動作が正しいです。
もしかしたら、シートモジュールのイベントのことを言われているのでしょうか？

データを入力したいシートタブ（左下のシート名）を右クリック。
コードの表示をクリック。
表示されたシートモジュールに以下を貼り付ける。

Private　Sub　Worksheet_Change(ByVal　Target　As　Range)
　With　Target
　　　　　　If　.Column　<>　1　Then　Exit　Sub
　　　　　　If　.Cells.Count　>　1　Then　Exit　Sub
　　　　　　With　.Range("B1:C1,E1:F1")　'Ｅ列以降はどこまで？
　　　　　　　　　　　Select　Case　Target.Value
　　　　　　　　　　　　　　　　　　Case　"晴れ"
　　　　　　　　　　　　　　　　　　　　　　　.Interior.ColorIndex　=　5　'仮に青
　　　　　　　　　　　　　　　　　　Case　"曇り"
　　　　　　　　　　　　　　　　　　　　　　　.Interior.ColorIndex　=　8　'仮に水色
　　　　　　　　　　　　　　　　　　Case　"雨"
　　　　　　　　　　　　　　　　　　Case　"台風"
　　　　　　　　　　　　　　　　　　Case　"不明"
　　　　　　　　　　　　　　　　　　Case　Else
　　　　　　　　　　　　　　　　　　　　　　　.Interior.ColorIndex　=　0　'上記以外は色なし
　　　　　　　　　　End　Select
　　　　　　End　With
　End　With
End　Sub
ではどうでしょうか。

補足

ありがとうございます！！入力するたびに変わりました！！
やっぱり私の説明不足でしたね。。。大変お手数をおかけいたしまして申し訳ございません！

ただ！！
迷惑をかけついでにもうひとつだけお願いします、、、
入力列がA列ではなくてL列になってしまったのですが、、、（泣）

If　.Column　<>　1　Then　Exit　Subを
If　.Column　<>　12　Then　Exit　Subにしてみたりしたのですが。。。（違ってますね。。。）

ご教授いただけますか。

回答No.6

n-jun

ANo.5です。

>確認させてください。
>コードを張るのは、Module1でいいのですよね？
はい。標準モジュールに貼って下さい。

動かないと言う点では、あとはアクティブなシートが
本来データのあるシートでない場合にも起こりえます。

補足

やはり何度設定しても、A列に「晴れ」と記入しても色は変わらず、マクロをあえて手で実行しないと指定のセルに色がつかないようです。。。
何度もお手数をおかけして申し訳ございませんでした。。。

回答No.5

n-jun

ANo.3です。

>新規のbookに試すと動くのですが、実際動かしたいbookでは動作しないのですが、何か注意点はありますか？
特にないはずです。
セルに入力されている「晴れ」「曇り」「雨」「台風」「不明」に、
無駄な空白等があれば可能性はあります。
その場合、
>Select Case r.Value
を
Select Case Trim(r.Value)
としてみて下さい。

補足

たびたび本当に申し訳ございません！！

VB画面の再生ボタン「Sub/ユーザーフォームの実行」を押すと動作するようです。
私の知識不足で動かないだけだとは思うのですが、、、

確認させてください。
コードを張るのは、Module1でいいのですよね？

何度も大変お手数をおかけしますがお願いします。。。

回答No.4

shut0325

No.2です。　補足確認しました。
それならばNo.1さんの解答で解決できるかと思います。
（非常にスマートなコードで私も勉強になりました。）

回答No.3

n-jun

ANo.1です。

>対象セルをあとでA1でなくなってしまった場合は有効でなくなってしまいませんでしょうか？
>出来ればシート全体で、その言葉が入力されたときにその行の指定の縦列が塗りつぶせると助かります。
シート全体とは、判断対象がＡ列以外と言う事でしょうか？
そうではなくＡ列に判断すべき項目があれば、問題ないですけど。
（試してません？）

＞ r.Range("B1:C1,E1:F1")
ｒはＡ１からＡ列の最終行までを順次取得します。
r.Range("B1:C1,E1:F1")はｒをセルＡ１と見立て、
その時のＢ１・Ｃ１・Ｅ１・Ｆ１を対象としています。
すなわち、ｒがＡ１０であればＢ１０・Ｃ１０・Ｅ１０・Ｆ１０が
塗りつぶしの対象となります。

補足

たびたび申し訳ございません。。

新規のbookに試すと動くのですが、実際動かしたいbookでは動作しないのですが、何か注意点はありますか？

回答No.2

shut0325

ちょっと確認です。
希望の処理は、

1.　A行の値によって、パターンに従って同列のB行以降のセルを塗りつぶす。
2.　パターンはA行の値によって５種類ある。
3.　どの値でも塗りつぶす色は同じ？？

ということで、

例えば　
A1＝晴れ　B1　C1　D1　F1　のセルを塗りつぶす
A2＝雨　　C2　E2　G2　H2　のセルを塗りつぶす
A3＝晴れ　B3　C3　D3　F3　のセルを塗りつぶす

というような処理だと解釈していいのでしょうか？

補足

説明不足で申し訳ございません。

塗りつぶしの行BCEF等は、固定のつもりです。

A1="晴れ"ならば、B2、C2、E2、F2・・・を青色、
A2="曇り"ならば、B2、C2、E2、F2・・・を赤色、
A3="雨"ならば、B2、C2、E2、F2・・・を黄色、
A4="晴れ"ならば、B2、C2、E2、F2・・・を青色。

回答No.1

n-jun

例えばこんな感じ。

Sub test()
Dim r As Range

For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))

With r.Range("B1:C1,E1:F1") 'Ｅ列以降はどこまで？

Select Case r.Value
Case "晴れ"
.Interior.ColorIndex = 5 '仮に青
Case "曇り"
.Interior.ColorIndex = 8 '仮に水色
Case "雨"
Case "台風"
Case "不明"
End Select

End With
Next
End Sub
「雨」「台風」「不明」については同様に
.Interior.ColorIndex = 色番号

色番号については
http://www.relief.jp/itnote/archives/000482.php
ご参考に。

補足

対象セルをあとでA1でなくなってしまった場合は有効でなくなってしまいませんでしょうか？
出来ればシート全体で、その言葉が入力されたときにその行の指定の縦列が塗りつぶせると助かります。

申し訳ございませんがよろしくお願いします。