こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

条件付書式のVBA

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

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

投稿日時 - 2008-08-22 10:55:35

QNo.4269434

困ってます

質問者が選んだベストアンサー

ANo.7です。

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

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

投稿日時 - 2008-08-28 13:19:31

お礼

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

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

投稿日時 - 2008-08-28 13:47:00

ANo.8

このQ&Aは役に立ちましたか?

13人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.7

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") 'E列以降はどこまで?
           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
ではどうでしょうか。

投稿日時 - 2008-08-28 10:57:24

補足

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

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

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


ご教授いただけますか。

投稿日時 - 2008-08-28 11:37:31

ANo.6

ANo.5です。

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

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

投稿日時 - 2008-08-27 17:29:13

補足

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

投稿日時 - 2008-08-28 10:09:27

ANo.5

ANo.3です。

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

Select Case Trim(r.Value)
としてみて下さい。

投稿日時 - 2008-08-27 13:04:11

補足

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

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

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

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

投稿日時 - 2008-08-27 14:52:39

ANo.4

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

投稿日時 - 2008-08-22 17:32:21

ANo.3

ANo.1です。

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

> r.Range("B1:C1,E1:F1")
rはA1からA列の最終行までを順次取得します。
r.Range("B1:C1,E1:F1")はrをセルA1と見立て、
その時のB1・C1・E1・F1を対象としています。
すなわち、rがA10であればB10・C10・E10・F10が
塗りつぶしの対象となります。

投稿日時 - 2008-08-22 14:30:55

補足

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

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

投稿日時 - 2008-08-27 12:26:30

ANo.2

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

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

ということで、

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

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

投稿日時 - 2008-08-22 12:00:32

補足

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

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

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

投稿日時 - 2008-08-22 13:16:20

ANo.1

例えばこんな感じ。

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") 'E列以降はどこまで?

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
ご参考に。

投稿日時 - 2008-08-22 11:42:33

補足

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

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

投稿日時 - 2008-08-22 14:11:40

あなたにオススメの質問