セル値を塗りつぶし色で区別したい

10行程度のマクロで、セル値に応じた塗りつぶしを、まとめて行うことができます塗りつぶす色ごとに条件付き書式を設定するのが普通ですが、以下のようなマクロを作って、セル値に応じた塗りつぶしをまとめて行う方法もあります。
Sub ColorCellsByRange() Dim cell As Range Dim lookupRange As Range Dim colorRange As Range Dim i As Long Dim color As Long 　 ' 対応する値と色が用意されている範囲 Set lookupRange = Sheets("シフトパターン").Range("A2:A8") Set colorRange = Sheets("シフトパターン").Range("H2:H8") 　 ' 対象範囲をループ For Each cell In Selection ' 対応する値と色を検索 For i = 1 To lookupRange.Rows.Count If cell.Value = lookupRange.Cells(i, 1).Value Then color = colorRange.Cells(i, 1).Interior.color cell.Interior.color = color Exit For End If Next i Next cell End Sub

	①セル値に応じた塗りつぶし色を、同じ行のセルに適用しておきます作例では、A列の「シフト名」に応じて、H列の塗りつぶし色を適用します。
	②VBAを起動して、シートをダブルクリックしますシートのモジュルールウィンドウが開くので、そこに左図のようなマクロを記述します。この VBAマクロ（ColorCellsByRange）は、選択範囲のセルの値を特定のリストと照合し、一致する値に対応したセルの塗りつぶし色を設定するものです。具体的には、lookupRange（検索範囲）で指定したリストに基づいて、選択範囲のセルの値を検索し、colorRange（色の設定範囲）のセルから対応する背景色を取得しながら、一致する値のセルに、その背景色を適用していきます。
Sub ColorCellsByRange() Dim cell As Range Dim lookupRange As Range Dim colorRange As Range Dim i As Long Dim color As Long	① 変数の宣言 cell → 処理対象となるセル（選択範囲のセルをループで取得） lookupRange → 検索する値のリスト（対応する値が書かれた範囲） colorRange → 対応する色のリスト（lookupRange の各値に対する色） i → ループ用のカウンタ変数 color → セルの背景色（RGB値）を格納する変数
' 対応する値と色が用意されている範囲 Set lookupRange = Sheets("シフトパターン").Range("A2:A8") Set colorRange = Sheets("シフトパターン").Range("H2:H8")	② 検索範囲と色範囲を設定シート "シフトパターン" の A2:A8 の範囲を lookupRange（検索範囲）とする H2:H8 の範囲を colorRange（色の取得範囲）とする A2:A8 にある値に対して、H2:H8 にあるセルの色を対応させる
' 対象範囲をループ For Each cell In Selection	③ 選択範囲をループ処理 Selection（現在選択されているセル範囲）を1つずつ cell に代入選択範囲のすべてのセルに対して処理を実行
' 対応する値と色を検索 For i = 1 To lookupRange.Rows.Count If cell.Value = lookupRange.Cells(i, 1).Value Then	④ 対応する値を検索 lookupRange 内で選択されたセル（cell）の値と一致するものを探す例えば、選択セルの値が "夜勤" なら、lookupRange の "夜勤" の行を探す
color = colorRange.Cells(i, 1).Interior.color cell.Interior.color = color Exit For End If Next i Next cell End Sub	⑤ 一致した場合、対応する色を取得一致した場合、その行の H列（colorRange）のセルの背景色を取得 cell.Interior.color = color で、現在のセルの背景色に適用一致したら処理を終了（Exit For）（無駄な検索を減らす）
	③色分けしたいセル範囲を選択してから、マクロを実行します
	④セル値に応じて、セルが塗り分けられます















	●入力された値に応じて、所定の塗りつぶしを行う、マクロ作成の動画です

	関連する他のページ
	わかりやすい数式にしたい表内の数式は、表をテーブル化することでわかりやすくなります納品書の日付と顧客名を自動転記したい元表がテーブル化されていれば、そのテーブル名と項目列名を指定して、納品番号から表引きできますテーブル化した商品リストから、商品コードで商品情報を表引きしたい表引きする側とされる側の両方をテーブル化すれば、項目列名で表引きすることができます『返却済』でない人だけを表示したいテーブル化すれば、フィルターで絞り込めます『返却』列のセルに、『済』を簡単に入力したい「データの入力規則」を使えば、マウス操作だけで「済」と入力できるようになります今日の日付と、2週間後の日付を、簡単に入力したい Ctrlキー＋；（セミコロン）キーで今日の日付を入力でき、それを元にした計算式で2週間後の日付を求められますテーブル化されている表から表引きしたい F5キーでテーブルおよび列の指定を簡単に行えます簡単に表の見栄えを整えたいテーブル化することで、見栄えの良いスタイルを簡単に適用できます見つけ出した素数を、他のシートで使いたいフィルタで抽出すれば、簡単にコピーできます条件付き書式で、素数だけを表示したい SUMPRODUCT関数を使った条件付き書式にします数式をわかりやすくしたい表をテーブル化しておくと、テーブル名や列名を使った数式を設定できます東京在住の人だけを表示したいテーブル化すれば、フィルターボタンで絞り込めます男女別の平均身長を求めたい① テーブル化して男女別にデータを絞り込めば、ステータスバーでその平均値を確認できますテーブル化した表に条件付き書式を設定したいテーブル化した表でも、通常の表と同じように条件付き書式を設定できますデータを絞り込んで表示したいテーブル化すれば、フィルターボタンで簡単にデータの絞り込みを行えますドロップダウンリストでプランを選びたい「データの入力規則」で任意のドロップダウンリストを設定できます表へのデータの追加をスムーズに行いたい表をテーブル化しておけば、データを追加したときに、自動的に同じ書式が適用されるようになります日本語入力のオンとオフを、入力するデータに応じて自動で切り替えたい「データの入力規則」→「日本語入力」を使えば、セルごとに日本語入力のオンとオフを自動で切り替えられますデータ行の増減を簡単に行いたいテーブル化した表なら、データ行の増減にも柔軟に対応できますテーブル化した表を使って表引きしたいあらかじめ適当なテーブル名をつけておけば、その名前で表引きを行えますスクロールしても項目行を常に確認できるようにしたい項目行を固定表示する方法はいくつかありますが、見栄えも同時に整えられる、表のテーブル化が便利です郵便番号や会員番号、日付の表示形式を整えたいユーザー定義すれば、ハイフン付きの表示や、表示桁位置の固定などを、データの修正なしに行えます数式をわかりやすくしたい① 対象セル範囲に名前をつけたり、表をテーブル化したりすることで、数式はわかりやすくなります前日シートのテーブルを、当日の新規シートでも使いたい前日シートのコピーで、当日の新規シートを作り、そのデータ範囲だけを削除する方法がありますブックを開いたときの新規シート自動挿入を、1日1枚に制限したい新規シートの名前に日付を加え、マクロ実行時にその存在の有無を確認するようにしますブックを開いたときに、新規シートを先頭へ挿入したい ThisWorkbookのOpenプロシージャに該当コードを記述します編集シートの前に新規シートを挿入したい Shift＋F11キーで行えます表の見栄えを良くしたいテーブル化してしまえば、用意されているデザインを適用して、簡単に見栄えを整えられます累計を自動計算する表が欲しいテーブル化した表なら、データの追加も、合計の計算も容易に行えます値が0になった行だけを、自動的に非表示にしたい WorksheetオブジェクトのActivateプロシージャを使って、表のあるシートが表示されたときに、フィルターによる絞り込みが自動的に再適用されるようにします条件付き書式を使って、値が0のときにその行を非表示にしたい条件付き書式では行えませんが、フィルターによる絞り込みでなら可能です金額の大小に応じて色分けしたい表示形式でも設定できます金額を千円単位で表示したい表示形式で桁区切りカンマの位置を変えると、千単位での数値表示に変えられます 2013/04/08号「午前と午後に分けて時刻を表示したい」午前と午後を表す文字は、「/」をはさんで指定します日付を曜日付きで表示したい曜日は書式記号の「aaa」で表示できます期日を過ぎたセルには別の警告色を表示したい 2つの条件付き書式を設定した場合は、上に位置するものが優先して適用されます期日の30日前からセルに警告色を表示したい期日と本日の差が30以内かどうかを調べる、条件付き書式を設定します表の見栄えを良くしたい「テーブルとして書式設定」を使って、表をテーブルに変えるのが簡単です日付を和暦で表示したい「カレンダーの種類」を「和暦」にします追加データの予定されている表から、条件に合致するデータの合計を求めたいテーブル化してあれば、データの追加が予定されている表からでも、 SUMIF関数で動的に合計を求めることができます表へのデータの追加を効率良く行いたいテーブル化すれば、追加データを入力するだけで、必要な数式まで自動的に設定できます表を簡単に見やすくしたい Excel 2010/2007なら、表をテーブル化すれば、簡単に見やすくできるとともに、表の拡張なども容易に行えるようにできます集計表を簡単に修飾したい Excel 2010/2007では、テーブルとして表を修飾します合計を求めるSUM関数式の結果に、「時間」を付けて表示したいユーザー定義の表示形式をセルに割り当てれば、「時間」付きで表示されるようになります労働時間を計算するユーザー定義関数を使って、残業時間を求めるユーザー定義関数を作りたい既存のユーザー定義関数は、別のユーザー定義関数内で実行して、その結果を利用することができます選択したセル範囲のデータから、一意のものを取り出したいマクロなら可能です選択したセル範囲のデータを、一列にまとめたい 10行程度のマクロでも行えます組み合わせ一覧を表示するマクロを、要素数と選び出す数を自由に指定できるものにしたい入れ子構造のマクロでは汎用的にできないので、再帰処理を使ったマクロにします ABCの観点別評価の組み合わせパターンを知りたい入れ子構造のマクロで求めることができますドロップダウンリストで選んだデータを、選んだ直後に、対応する別データに置換して入力したいセル値の変化を監視するマクロで実行できます置換リストを使って、複数の置換をまとめて行いたい 10行程度のマクロで、置換リストを使った一斉処理が可能ですセルに入力されている文字列を、そのシート名にしたい簡単なマクロで実現できますマクロ実行の対象範囲を固定したいセルやセル範囲は、 Rangeで指定できます選択中のセル範囲に含まれる空セルを、マクロ処理の対象から除外したい空セルでないことを条件に、マクロを実行するよう、 If文を追加します選択中のセル範囲に対してのマクロ実行結果を、別のセルに表示したい Offsetを使うと、対象のセルの位置を行列単位でずらすことができます選択中のセル範囲に対するマクロを作りたい For Each～Nextで、選択中のセル範囲（Selection）に対する処理を記述します

セル値を塗りつぶし色で区別したい

10行程度のマクロで、 セル値に応じた塗りつぶしを、 まとめて行うことができます

Sub ColorCellsByRange()

Dim cell As Range

Dim lookupRange As Range

Dim colorRange As Range

Dim i As Long

Dim color As Long

' 対応する値と色が用意されている範囲

Set lookupRange = Sheets("シフトパターン").Range("A2:A8")

Set colorRange = Sheets("シフトパターン").Range("H2:H8")

' 対象範囲をループ

For Each cell In Selection

' 対応する値と色を検索

For i = 1 To lookupRange.Rows.Count

If cell.Value = lookupRange.Cells(i, 1).Value Then

color = colorRange.Cells(i, 1).Interior.color

cell.Interior.color = color

Exit For

End If

Next i

Next cell

End Sub

①セル値に応じた塗りつぶし色を、同じ行のセルに適用しておきます

②VBAを起動して、シートをダブルクリックします

Sub ColorCellsByRange()

Dim cell As Range

Dim lookupRange As Range

Dim colorRange As Range

Dim i As Long

Dim color As Long

① 変数の宣言

' 対応する値と色が用意されている範囲

Set lookupRange = Sheets("シフトパターン").Range("A2:A8")

Set colorRange = Sheets("シフトパターン").Range("H2:H8")

② 検索範囲と色範囲を設定

' 対象範囲をループ

For Each cell In Selection

③ 選択範囲をループ処理

' 対応する値と色を検索

For i = 1 To lookupRange.Rows.Count

If cell.Value = lookupRange.Cells(i, 1).Value Then

④ 対応する値を検索

color = colorRange.Cells(i, 1).Interior.color

cell.Interior.color = color

Exit For

End If

Next i

Next cell

End Sub

⑤ 一致した場合、対応する色を取得

③色分けしたいセル範囲を選択してから、マクロを実行します

④セル値に応じて、セルが塗り分けられます

●入力された値に応じて、所定の塗りつぶしを行う、マクロ作成の動画です

関連する他のページ

10行程度のマクロで、セル値に応じた塗りつぶしを、まとめて行うことができます