[VBA] エクセルマクロでステータスにより背景色を変更する（複数色可）

• ステータスの変更をキーに、対象行の指定列の背景色を変更する

• エクセルのマクロを利用する。
• キー列の変更により、対象行の色を変更する。（今回の場合はステータス列）
• 色を変化させる列を指定することにより、範囲内の列の色を変化させる。

下記ソースを、シートオブジェクトに記載してください。（シートの対象列の変化をキーに色変更を実施するため、標準モジュールに記載しても動作しません。。おそらくですが(´・ω・｀)

Option Explicit
 
'# ---------------------------------------------------------
'# 変数定義
'# ---------------------------------------------------------
'# 行：列情報
Private Const COL_NO_CHECK As Integer = 2 '# チェックする対象行を判断する列番号
Private Const COL_NO_TRIGGER As Integer = 6 '# 色を変化させるトリガーとなる列番号
Private Const COL_COLOR_START As Integer = 2 '# カラー変更開始列番号
Private Const COL_COLOR_END As Integer = 9 '# カラー変更終了列番号
Private Const ROW_SEARCH_START As Integer = 5 '# 開始行番号

'# ステータス情報
Private Const STATUS_NONE As String = "未着手"
Private Const STATUS_NOW As String = "仕掛中"
Private Const STATUS_CHECK As String = "確認中"
Private Const STATUS_DONE As String = "完了"

'# ---------------------------------------------------------
'# ステータス変更により背景色を変更
'# ---------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    
    '# ステータス列以外が変更された場合は起動しない
    If Target.Column <> COL_NO_TRIGGER Then
        Exit Sub
    End If
    
    '# 変数宣言
    Dim int_row_num As Integer '# 行番号
    Dim str_status As String '# ステータス名
 
    '# 初期化
    int_row_num = ROW_SEARCH_START
    
    '# 現在のシートを対象とする
    With ActiveSheet
 
        '# -----------------------------------------------------
        '# 最終行まで、ステータスを確認しながら背景色変更
        '# -----------------------------------------------------
        Do While .Cells(int_row_num, COL_NO_CHECK).Value <> ""
 
            '# ステータス情報取得
            str_status = CStr(.Cells(int_row_num, COL_NO_TRIGGER).Value)
 
            '# カラーチェンジ
            If str_status = "" Or str_status = STATUS_NONE Then
 
                '# 空欄または未着手の場合は背景は白色
                Range(Cells(int_row_num, COL_COLOR_START), Cells(int_row_num, COL_COLOR_END)).Interior.ColorIndex = 2
 
            ElseIf str_status = STATUS_CHECK Then
 
                '# 仕掛中は背景を黄緑色
                Range(Cells(int_row_num, COL_COLOR_START), Cells(int_row_num, COL_COLOR_END)).Interior.ColorIndex = 43
 
            ElseIf str_status = STATUS_NOW Then
 
                '# 仕掛中の場合は背景は赤
                Range(Cells(int_row_num, COL_COLOR_START), Cells(int_row_num, COL_COLOR_END)).Interior.ColorIndex = 22
 
            ElseIf str_status = STATUS_DONE Then
 
                '# 完了の場合は背景はグレー
                Range(Cells(int_row_num, COL_COLOR_START), Cells(int_row_num, COL_COLOR_END)).Interior.ColorIndex = 15
 
            End If
 
            '# 行番号を更新
            int_row_num = int_row_num + 1
        Loop
 
    End With
 
End Sub