条件を満たした時にセルの色を3色以上変更した

質問

エクセルで下記のような予約管理表を作っているのですが
　　A　　　B　　　C　　　　D　　　　　　　E　　　　F　 G　 H　 I
１　No　日付　　時間　　お名前　　　人数　　 席
２　1　　1/1　　19:00　　　○○様　　　15　　　 1　 2　 3　 4
３　2　　1/1　　19:30　　　××様　　　10　　　15　 16　
４　3
・　　
・
・
・
・
この予約表とリンクさせて座席表(店の地図）の塗りわけをしたいと考えています。
予約表の2行目に座席番号があれば赤
3行目なら黄色　4行目なら青　という感じで最大40色ぐらいの色分けをしたいのですが
教えていただけないでしょうか？

3色以上の色分けはVBAでしか出来ないと聞いたもので
VBAの本やネットでも調べたのですが分かりませんでした・・・
VBAに関しては全くの初心者ですが、宜しくお願いします。

回答No.3

imogasi

>座席表(店の地図）の塗りわけをしたいと考えています。
予約管理表を作っているのですが,とあるので、座席表は予約管理表のことか？。呼び方を統一すること。
ーー
●また予約表の実例ぐらい挙げて質問すること。回答者が＃１のご回答のように例を作ることになるが、質問者が作るのが
正確性の点からも望まく、礼儀でもあるでしょう。
●エクセルのバージョンも質問に書いてない。２００７なら３色の制約はなくなっているのでは。
●ＶＢＡのＣｏｌｏｒＩndexは５６種あるが、４０種の色を設定しても、似た色が多くて判別は難しいので、理屈倒れ（色を着けたというだけ）では無いですか。１０種ぐらいしか、セットされた色の判別は、難しいのでは。
ーーー
予約表の例えばＣ列において、座席番号が在るとして、
第2行目ならＪ列に、赤の色コード3
３行目ならＪ列に黄色の色コード黄色6
４目ならＪ列に黄色の色コード青色5
ーー
を記入しておく。
Ｓｈｅｅｔ２
Ｃ列　　ｊ列
23　　3
25　 6
26 5
Ｓｈｅｅｔ１
Ｃ列
23
26
25
・・・
・・・ーーーーーー
標準モジュールに
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("C65536").End(xlUp).Row
MsgBox d
For i = 2 To d
x = Cells(i, "C")
c = Application.WorksheetFunction.VLookup(x, sh2.Range("C2:J100"), 8, False)
MsgBox c
Range(sh1.Cells(i, "a"), sh1.Cells(i, "H")).Interior.ColorIndex = c
Next i
End Sub
を入れて実行する。
Ｓｈｅｅｔ２は第１００行間での例、＜－－ sh2.Range("C2:J100")
Ｓｈｅｅｔ２でＣ列に番号が見つからない場合のことは織り込んでない。
ーー
しかし
＞VBAの本やネットでも調べたのですが分かりませんでした・・・程度では
このコードは、Ｓｈｅｅｔ２の色コードの情況が変わると自動的には変わらないなどのことあるし、シートのデータ項目列など例が少し変わっただけで、修正の仕方がわからないのではないか。
だから回答しても役立つか疑わしい。

回答No.2

imogasi

>座席表(店の地図）の塗りわけをしたいと考えています。
予約管理表を作っているのですが,とあるので、座席表は予約管理表のことか？。呼び方を統一すること。
ーー
●また予約表の実例ぐらい挙げて質問すること。回答者が＃１のご回答のように例を作ることになるが、質問者が作るのが
正確性の点からも望まく、礼儀でもあるでしょう。
●エクセルのバージョンも質問に書いてない。２００７なら３色の制約はなくなっているのでは。
●ＶＢＡのＣｏｌｏｒＩndexは５６種あるが、４０種の色を設定しても、似た色が多くて判別は難しいので、理屈倒れ（色を着けたというだけ）では無いですか。１０種ぐらいしか、セットされた色の判別は、難しいのでは。
ーーー
予約表の例えばＣ列において、座席番号が在るとして、
第2行目ならＪ列に、赤の色コード3
３行目ならＪ列に黄色の色コード黄色6
４目ならＪ列に黄色の色コード青色5
ーー
を記入しておく。
Ｓｈｅｅｔ２
Ｃ列　　ｊ列
23　　3
25　 6
26 5
Ｓｈｅｅｔ１
Ｃ列
23
26
25
・・・
・・・ーーーーーー
標準モジュールに
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("C65536").End(xlUp).Row
MsgBox d
For i = 2 To d
x = Cells(i, "C")
c = Application.WorksheetFunction.VLookup(x, sh2.Range("C2:J100"), 8, False)
MsgBox c
Range(sh1.Cells(i, "a"), sh1.Cells(i, "H")).Interior.ColorIndex = c
Next i
End Sub
を入れて実行する。
Ｓｈｅｅｔ２は第１００行間での例、＜－－ sh2.Range("C2:J100")
Ｓｈｅｅｔ２でＣ列に番号が見つからない場合のことは織り込んでない。
ーー
しかし
＞VBAの本やネットでも調べたのですが分かりませんでした・・・程度では
このコードは、Ｓｈｅｅｔ２の色コードの情況が変わると自動的には変わらないなどのことあるし、シートのデータ項目列など例が少し変わっただけで、修正の仕方がわからないのではないか。
だから回答しても役立つか疑わしい。

回答No.1

tom04

こんばんは！
外していたらごめんなさい。
一例です。
実際の「座席表」がどのような配置か判らないので勝手に↓のような感じにしてみました。

＞予約表の2行目に座席番号があれば赤
3行目なら黄色　4行目なら青　という感じで最大40色ぐらいの・・・
とあるのでとりあえずSheet1「予約表」のA列を好みの色にしておきます。

そしてSheet2にSheet1「予約表」？のF列以降に座席番号があればSheet1のA列の色を表示するようにしてみました。

尚、Sheet1の予約表に座席番号の重複はないものとします。
（もし重複があれば下の行の色が表示されると思います。）

標準モジュールに下のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub test() 'この行から
Dim i, j, k, L As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1") '←Sheet名は「予約表」等適宜変更
Set ws2 = Worksheets("sheet2") '←こちらのSheet名も適宜変更
For i = 2 To ws1.Cells(Rows.Count, 6).End(xlUp).Row
For j = 6 To ws1.Cells(i, Columns.Count).End(xlToLeft).Column
For k = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
For L = 1 To ws2.Cells(k, Columns.Count).End(xlToLeft).Column
If ws2.Cells(k, L) = ws1.Cells(i, j) Then
ws2.Cells(k, L).Interior.Color = ws1.Cells(i, 1).Interior.Color
End If
Next L
Next k
Next j
Next i
End Sub 'この行まで

あくまで一案ですので
他に良い方法があればごめんなさいね。

それでは良いお年を！m(__)m