エクセル別シートの書式（塗りつぶし）を条件付き書式の塗りつぶしに自動的に反映させたい

Question

エクセルで（2010）予約表を作っています。

データ用のシート（Sheet1)に名前を入力し、別シート（Sheet2）に「データの入力規則」を使ってプルダウンリストで時間別（1時間ごと）の予約表を作りました
Sheet1のデータに名前ごとに色分けしてセルを塗りつぶしています。
今の段階ではSheet2で同じく色分けをしようとすると、条件付き書式で書式（塗りつぶし）をいちいち入れなおさなければできません。
始めは、人数も少なかったので既定の色で間に合ったのですが、人数が増えると色も微妙に変えなければならず、その色をいちいち探して入れなおすのが面倒になってきました。
何か手数を減らして、効率的に塗りつぶしを反映する方法はありませんか？
マクロを使う方法しかないのでしょうか？
マクロもよくわかっていないので、いつも教えて頂いたマクロをコピペしているようなレベルです。

なのとぞご教示いただけますようよろしくお願い致します。

tom04 · Accepted Answer

＞フォントの色や、太字などの設定のコードがあれば・・・

前回のSheet2の表はフォント色と塗りつぶしの色を両方をA列だけにしてみてはどうでしょうか？

そして、条件付き書式が設定してある場合は条件付き書式の方が優先されますので、
条件付き書式は解除しておいてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long, lastCol As Long
Dim c As Range, myRng As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
lastCol = Cells(3, Columns.Count).End(xlToLeft).Column
Set myRng = Range(Cells(4, "G"), Cells(lastRow, lastCol))
If Intersect(Target, myRng) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
If .Value <> "" Then
Set c = wS.Range("A:A").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
    .Interior.Color = c.Interior.Color
    .Font.Color = c.Font.Color
    If c.Font.Bold = True Then  '//★//
        .Font.Bold = True
    End If  '//★//
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
.Font.Bold = False
End If
End With
End Sub

※　フォントスタイルは「太字」か「標準」のどちらかだという前提です。
たとえば「斜体」などある場合は、一つ一つ指定するより
いっそのことSheet2のA列該当セルをそのままコピー＆ペーストする方が手っ取り早いかもしれません。
ただし、この場合無限ループに陥りますので気を付ける必要があります。

※　「★」の行だけに手を加えています。m(_ _)m

tom04 · Answer

こんばんは！

画像は「Sheet1」で3行目が項目行（時間帯？）が入っていて、
G列から4行目以降に「氏名」が入る！という前提です。

↓の画像のようにSheet2に氏名と色の対応表を作成しておけばVBAで簡単にできると思います。
以下のコードをSheet1のシートモジュールにしてください。

Private Sub Worksheet_Change(ByVal Target As Range) '//この行から//
    Dim lastRow As Long, lastCol As Long
    Dim c As Range, myRng As Range, wS As Worksheet
        Set wS = Worksheets("Sheet2")
            lastRow = Cells(Rows.Count, "C").End(xlUp).Row
            lastCol = Cells(3, Columns.Count).End(xlToLeft).Column
            Set myRng = Range(Cells(4, "G"), Cells(lastRow, lastCol))
                If Intersect(Target, myRng) Is Nothing Or Target.Count > 1 Then Exit Sub
                With Target
                    If .Value <> "" Then
                    Set c = wS.Range("A:A").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
                        .Interior.Color = c.Offset(, 1).Interior.Color
                    Else
                        .Interior.ColorIndex = xlNone
                    End If
                End With
End Sub '//この行まで//

※　行方向はG4セル以降C列データがある行まで、
列方向はG列以降3行目のデータがある列までを色付けの範囲としています。m(_ _)m

エクセル 別シートの書式（塗りつぶし）を条件付き書式の塗りつぶしに自動的に反映させたい

＞フォントの色や、太字などの設定のコードがあれば・・・

こんばんは！

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセル別シートの書式（塗りつぶし）を条件付き書式の塗りつぶしに自動的に反映させたい