条件付き書式4つ以上のＶＢＡについて教えてください。

質問

条件付き書式4つ以上でのVBAの作成方法を教えて下さい。

下記のような表があります。
　　A　　　　　B　　　　　C　　　　　D　　　　E　　　　　F　　　　G　　　　　H　　　　　I　　J　　K・・・
１　開始日　　終了日　　　開始日　　終了日　　開始日　　終了日　　開始日　　終了日　　　4/1　2　　3　　4 ・・・
２　2008/4/10 2008/4/20　2008/5/10 2008/5/20　2008/6/10 2008/6/30　2008/7/10 2008/7/19　（ここのセルに色をつけたい）
３　2008/4/03 2008/4/20　2008/5/10 2008/5/20　2008/6/10 2008/6/30　2008/7/10 2008/7/191　（ここのセルに色をつけたい）
・・・以下複数行

条件付き書式の設定方法
「数式が」「=AND(I$1>=$A1,I$1<=$B1)」の場合
「セルのパターンを（任意の色）」と設定

はわかるのですが、
開始日と終了日が4つ以上（実際は７つあります）あり
これを1行に表したいのです。
各工程を色で表したいのです（(1)工程A～B(セルの色：赤)、(2)工程Ｃ～Ｄ(青)…）

できれば色をつけた上で、(1)工程と色がついたセルの上に入力したいです。
（※こちらは難しそうなので色をつける方法だけでもお願いします。）、
どうしてもVBAの設定がわからないので教えて下さい。よろしくお願い致します。
初心者なのでＶＢＡの設定方法（どこに入力し、どのように実行すればよいか）も教えていただければ助かります！！

回答No.6

fumufumu_2006

ANo.5です。

>なぜか1行のみ変更となってしまいます。
ちょっと話がわからないのですが、＋5の場合は、
「データ」シートの2行目を変更すると、「Sheet1」シートの7行目が変更される
「データ」シートの3行目を変更すると、「Sheet1」シートの8行目が変更される
「データ」シートの4行目を変更すると、「Sheet1」シートの9行目が変更される
はずです。
>なぜか1行のみ変更となってしまいます。
とはならないはずです。
少なくても、「データ」シートの変更が1行目の場合「Sheet1」シートの6行目が変更されるので、
>の＋5の影響か,「Sheet1」の5行目の書式が変更されたので、
という状況にはならないはずです。
ただ、現状の「データ」シートのプログラムでは、変更がコピーペーストなどの複数セルの同時変更には対応していないので、その場合は1行だけが変更されます。
と言う訳で、「データ」シートの変更が1セルづつなら変わるけれど、範囲で変更されたらだめだと言うなら、データシートのモジュールを以下に変えてください。
また「Sheet1」シートの日付の計算式によって
Case 1, 6, 8, 10, 11, 18, 20 ...
の部分を適切に変更してください。
たとえばｍSheet1の日付区間の計算式が
=IF((データ!$A2)="","",データ!$A2)
=IF((データ!$AA2)="","",データ!$AA2)
なら、（A=1,AA=27)
Case 1, 27 ...
に変更してください。
また、
>Sheet1のA7…=IF((データ!$A2)="","",データ!$A2)
>Sheet1のB7…=IF(データ!$AA2="","",データ!$AA2)
についてですが、ANo.4の補足で、Sheet1の日付がB-O列で、組み合わせがB-C区間、D-E区間...のはずですので、A7が日付データの場合は正しく表示しないはずです。
だんだん最初の質問から実際のデータが違ってきているので、整理して修正しないと正しく表示できないと思います。
また、最初はSheet1のA-H列が日付だという事で組んでいるので、Sheet1のプログラムも変更が必要なのですが、まずは動く事を目的にしたいと思います。
本当はSheet1側のプログラムを変更すべきなのですが、「データ」シート側で複数変更に対応します。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
For Each r In Target
Select Case r.Column
Case 1, 27 '「データ」シート側のA,AA列(A=1,AA=27)が変更されたら（他の列がある場合は追加してください）
Sheets("Sheet1").Worksheet_Change Cells(r.Row + 5, 1) 'Sheet1のWorksheet_Changeを実行。
End Select
Next
End Sub

p.s.
もしも、これでもちゃんと動かなかったら・・・
最初の質問と実際にしたい事が違っているので、実際のデータ状況とデータ変更の方法を教えてもらえれば、そちらで説明させてもらった方が早いかもしれません。
実際のSheet1（シート名も実際の名前があるなら、それに合わせます）の日付見出し（最初の質問の１行目）が何行目か？
日付区間がどういうペアでいくつあるか？（A-B?なのかB-Cなのか、B-C,D-E,F-G,H-I,J-K,L-M,N-Oでいいのか）
日付区間の開始行が何行目から始まるのか?（7行目から?）
その計算式は何なのか？
B7=IF((データ!$A2)="","",データ!$A2)
C7=IF(データ!$AA2="","",データ!$AA2)
とか？

それと最初に間違ったのですが、Application.Matchというのを使ってますが、これは古い方法で間違いではないのですが、本当はFindというのを使うのがいいと思っていたので・・・

回答No.5

fumufumu_2006

たぶんわかったような気がします。
Sheet1のB7に入っている計算式が=データ!A2だった場合などの、Sheet1とデータの行が違う場合に問題が起こるのだと思います。
Sheet1のA7の計算式が=データ!A2だった場合で考えます。
ANo.3のプログラムでは、「データ」シートのセルの変更で、データのA2（2行目）を変更すると、Sheet1に2行目を変更した場合のチェックをさせます。
実際にチェックしなければいけないのは7行目です。
ということで、チェックする行を補正して伝えます。
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 1, 6, 8, 10, 11, 18, 20 '「データ」というシートのA,F,H,J,K,R,T列が変更されたら（1個足りないのだけど）
'下は、Target(このシートの変更されたセル）の行(例えばA2だった場合は2)と、それによって計算式で変更されたSheet1のセルの行(例えばA7が変更された場合は7)の違いを補正するための+5を付けてSheet1のWorksheet_Changeを呼ぶ
Sheets("Sheet1").Worksheet_Change Cells(Target.Row + 5, 1) 'Sheet1のWorksheet_Changeを実行。必要なのは行番号で、列番号は8(A-Hの場合)以下なら実行するので適当に1にしてます。
End Select
End Sub

p.s.
これでうまく動かない場合は、Sheet1のA7とB7に入っている計算式も教えてください。

補足

上記のように変更したところ
Sheets("Sheet1").Worksheet_Change Cells(Target.Row + 5, 1)
の＋5の影響か,「Sheet1」の5行目の書式が変更されたので、
＋7に変更したら、「Sheet1」の７行目のみ
＋8に変更したら、「Sheet1」の８行目のみ
書式が正常になりました。
なぜか1行のみ変更となってしまいます。
参考に
Sheet1のA7…=IF((データ!$A2)="","",データ!$A2)
Sheet1のB7…=IF(データ!$AA2="","",データ!$AA2)
という計算式をしようしております。
私が詳しくない為、初歩的なミスをしているのかもしれません。
お手数をおかけしてすみません。

回答No.4

fumufumu_2006

>このプログラムは組めたのですが、No.3の回答を試したのですが、
>うまくいきません
どううまくいかないかわからないと、何とも言えないのですが・・・

「データ」というシートのモジュール部に
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "データシートのデータ変更"
Select Case Target.Column
Case 1, 6, 8, 10, 11, 18, 20
MsgBox Target.Address & "が変更されました"
Sheets("Sheet1").Worksheet_Change Cells(Target.Row, 1)
End Select
End Sub
をコピーしてください。
データシートのどれかを変更すると、
「データシートのデータ変更」
と表示するはずです。
表示しない場合は、プログラムの場所がおかしいか、マクロが実行できない状態ではないかと思います。
データシートのA,F,H,J,K,R,T列が変更されたら、
「$a$1が変更されました」
とか表示されるはずです。
その後エラーで止まるようなら、手動で動くようになって、A-H列を計算式に戻したシートの名前が間違っていると思います。
表示はされるのだけど、正しくならない場合は、データの日付の部分の書式が「日付」または「標準」になっていない（「文字列」とかになっていないか）
などで試してください。
うまくいかない場合は、どううまくいかないかを教えてください。

>この貼り付けの作業行った後、このマクロが動作するようにしたいのですが、やはり初心者には難しいのでしょうか？
思った通りにいかない場合の対処などは慣れの部分もあるので、ある程度の苦労は必要だと思います。
ただ、あまり苦労せずに経験値を上げるためには、効率よく質問（「うまくいかない」ではなく「こうこうなって、うまくいかない」）して欲しいです。

p.s.
完全独学のため、昔はとても苦労しました(苦労は今でもですが)。
インターネットの無い頃は、書籍だけがたよりですが、地方では種類も少ないし、価格も高かった・・・
今はかなり楽なんですよ（と、年寄りくさい）。

補足

お返事ありがとうございます。
具体的に言いますと
>「$a$1が変更されました」とか表示されるはずです。
ここまではうまくいくのですが、
実際にSheet1を開くとデータ(A-H、実際はB-O)は計算式どおりにちゃんと表示されているのですが、セルの色が全く変わっていません。

コードの記入場所ですが、「標準モジュール」は使用していません。各々のコード表示の場所に記入しています。

下記に実際の表記を書きます。
実際はB-O列(7区間14個の場合、A列には番号が入っています)、データの開始行は7行目で使用しています。
(カレンダの日付は5行目に入力しています)

P.S.本当にお早い回答助かっています。
まだまだVBAの初歩的なことからわからないのにこのような質問に対して回答いただいてありがとうございます。

Public Sub Worksheet_Change(ByVal Target As Range)
Dim c1 As Variant
Dim c2 As Variant
If Target.Column <= 15 Then 'B-O列の場合
'現在の設定クリア
'Range(Cells(Target.Row, 9), Cells(Target.Row, Cells(1, Columns.Count).End(xlToLeft).Column)).Interior.ColorIndex = xlNone
'本当はこれが正しいんだろうけど複雑なので
Rows(Target.Row).Interior.ColorIndex = xlColorIndexNone '変更された行の背景色をクリア
'B-C区間
c1 = Application.Match(Cells(Target.Row, 2), Rows(5), 0) '変更された行のA列の値を5行目から探す
c2 = Application.Match(Cells(Target.Row, 3), Rows(5), 0) '変更された行のB列の値を5行目から探す
If (Not IsError(c1)) And (Not IsError(c2)) Then
If (c1 <= c2) Then
Range(Cells(Target.Row, c1), Cells(Target.Row, c2)).Interior.ColorIndex = 3 '赤
End If
End If
'D-E区間
c1 = Application.Match(Cells(Target.Row, 4), Rows(5), 0) '変更された行のC列の値を5行目から探す
c2 = Application.Match(Cells(Target.Row, 5), Rows(5), 0) '変更された行のD列の値を5行目から探す
If (Not IsError(c1)) And (Not IsError(c2)) Then
If (c1 <= c2) Then
Range(Cells(Target.Row, c1), Cells(Target.Row, c2)).Interior.ColorIndex = 4 '黄緑
End If
End If
…以下省略
'F-G区間（省略します。）
'H-I区間（省略します。）
'J-K区間（省略します。）
'L-M区間（省略します。）
'N-O区間（省略します。）
End If
End If
End If
End Sub

回答No.3

fumufumu_2006

ANo.2です。
>別シートの指定方法があれば教えて下さい。
こんな方法はどうでしょうか？
あまり変更しない方法です。

まず、1番目の方法でも2番目の方法でもいいので、直接入力した場合、ちゃんと表示するようにプログラムを組んでください。
完成したら、A-H（4区間8個の場合)を計算式に戻します。
これを「データ」というシートからも呼び出せるように変更します。
Private Sub Worksheet_Change(ByVal Target As Range)<-変更前
の「Private」を「Public」に変更します。
Public Sub Worksheet_Change(ByVal Target As Range)<-変更後
以上で変更は終了です。
ちなみに、このシートの名前を「Sheet1」だとします。
次に、「データ」というシートのモジュール部に
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 1, 6, 8, 10, 11, 18, 20 '「データ」というシートのA,F,H,J,K,R,T列が変更されたら（1個足りないのだけど）
Sheets("Sheet1").Worksheet_Change Cells(Target.Row, 1) 'Sheet1のWorksheet_Changeを実行。必要なのは行番号で、列番号は8(A-Hの場合)以下なら実行するので適当に1にしてます。
End Select
End Sub
を入れてください。
これで動くと思います。（補足のA,F,H,J,K,R,Tでは1つ足りないのですが）

p.s.
本当はSheet1の「Worksheet_Change」という名前を変えた方がいいとか「If Target.Column <= 8 Then 'A-H列の場合」はいらないとかありますが・・・

補足

早速の回答ありがとうございます。
>まず、1番目の方法でも2番目の方法でもいいので、直接入力した場合、ちゃんと表示するようにプログラムを組んでください。
このプログラムは組めたのですが、No.3の回答を試したのですが、
うまくいきません。
「データ」というシートについてですが、
データ．CSV→データ.xlsに変換したエクセルが別ファイルにあります。
この別ファイルのシートの全体を選択して、
コピー、その後この「データ」というシートに値のみ貼り付けしています。
この貼り付けの作業行った後、このマクロが動作するようにしたいのですが、やはり初心者には難しいのでしょうか？

回答No.2

fumufumu_2006

こんなのではどうでしょうか？

ちなみに、I1からの4/1 2 3 ... は表示だけで、実際は日付データ(2008/4/1 2008/4/2 2008/4/3 ...)だという場合です。
質問のデータで、A-B赤、C-D青にします。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c1 As Variant
Dim c2 As Variant
If Target.Column <= 8 Then 'A-H列の場合
'現在の設定クリア
'Range(Cells(Target.Row, 9), Cells(Target.Row, Cells(1, Columns.Count).End(xlToLeft).Column)).Interior.ColorIndex = xlNone '本当はこれが正しいんだろうけど複雑なので
Rows(Target.Row).Interior.ColorIndex = xlColorIndexNone '変更された行の背景色をクリア
'A-B区間
c1 = Application.Match(Cells(Target.Row, 1), Rows(1), 0) '変更された行のA列の値を1行目から探す
c2 = Application.Match(Cells(Target.Row, 2), Rows(1), 0) '変更された行のB列の値を1行目から探す
If (Not IsError(c1)) And (Not IsError(c2)) Then
If (c1 <= c2) Then
Range(Cells(Target.Row, c1), Cells(Target.Row, c2)).Interior.ColorIndex = 3 '赤
End If
End If
'C-D区間
c1 = Application.Match(Cells(Target.Row, 3), Rows(1), 0) '変更された行のC列の値を1行目から探す
c2 = Application.Match(Cells(Target.Row, 4), Rows(1), 0) '変更された行のD列の値を1行目から探す
If (Not IsError(c1)) And (Not IsError(c2)) Then
If (c1 <= c2) Then
Range(Cells(Target.Row, c1), Cells(Target.Row, c2)).Interior.ColorIndex = 5 '青
End If
End If
End If
End Sub

7区間の場合です。
上の各区間の設定を繰り返してもいいのですが、ループにしてみました。
ついでに背景色をcolorindexで指定すると濃すぎるので、rgb()で中間色も指定できるようにしました。
質問のデータが4区間なので、質問のデータでは「For i=1 To 4」にしないと、正しく表示しません。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c1 As Variant
Dim c2 As Variant
Dim c As Variant
Dim i As Integer
'各区間の色設定
'c = Array(3, 5, 4, 6, 7, 8, 9) '背景色(ColorIndexを使う場合)
c = Array(RGB(255, 192, 192), RGB(192, 192, 255), RGB(192, 255, 192), RGB(255, 255, 192), RGB(255, 192, 255), RGB(192, 255, 255), RGB(255, 255, 255))
If Target.Column <= 14 Then 'A-N列の場合(7区間) 質問のデータの場合は4区間なので8にしてください
'現在の設定クリア
Rows(Target.Row).Interior.ColorIndex = xlColorIndexNone '変更された行の背景色をクリア
'A-B区間
For i = 1 To 7 '質問のデータの場合は4区間の4にしないと、おかしくなります
c1 = Application.Match(Cells(Target.Row, i * 2 - 1), Rows(1), 0) '変更された行のA列の値を1行目から探す
c2 = Application.Match(Cells(Target.Row, i * 2), Rows(1), 0) '変更された行のB列の値を1行目から探す
If (Not IsError(c1)) And (Not IsError(c2)) Then
If (c1 <= c2) Then
'Range(Cells(Target.Row, c1), Cells(Target.Row, c2)).Interior.ColorIndex = c(i - 1) 'ColorIndexを使う場合は、上のc=array(...)でColorIndex用のデータを用意しておく
Range(Cells(Target.Row, c1), Cells(Target.Row, c2)).Interior.Color = c(i - 1)
End If
End If
Next
End If
End Sub

お礼

ありがとうございます！
1番目の方法でできましたのですが…
（2番目の方法は私には難しいようです）
あと補足として、
実はA～H行が別シートにあり
データ参照で持ってきています。
その為、変更された行というのが有効にならないようです。
別シートの指定方法があれば教えて下さい。
説明不足ですみません。

補足

ありがとうございます！
1番目の方法でできましたのですが…
（2番目の方法は私には難しいようです）
補足内容として、
実はA～H行が別シートにあり
(例：「データ」というシートのA,F,H,J,K,R,T行から)
データ参照(IF(データ!$A2="","",データ!$A2)）で持ってきています。
その為、変更された行というのが有効にならないようです。
別シートの指定方法があれば教えて下さい。
説明不足ですみません。

回答No.1

imogasi

条件付書式は、セルの値を見ていて、セルの値が変わるとセルパターン色に即座に反映されます。ここがミソだと思います。
条件判断などは、IF文での分岐を増やすとか、Case文を増やせば仕舞いです。いくらでも（色の区別が出来ないほどに増えないうちは）、数を増やせます。
問題は即座反応性です。
これはワークシートのChangeイベントで値の変化を捉え、判別ルーチンを通して、ルールで決まった色をセットしなおせばよい。
しかしChangeイベントはクセがあったりして、色々なケースでテストし、うまくいくか考えること。

お礼

ありがとうございます！
VBAを使用するのが初めてですので、
具体的に説明して下さったらありがたいです！