条件に基づき、指定範囲のセルの背景色を変更

Sub prcFillGreyIfConditionMet()
    ' 7行目に文字が入力されている場合に指定範囲のセルの背景色を塗りつぶす

    Const strRangeAddress As String = "F2:NG102" ' アドレスの範囲
    Const lngFillColor As Long = 15921906 ' 塗りつぶす色(薄いグレー色)

    Dim rngCell As Range ' 処理対象のセル
    Dim rngColumn7 As Range ' 各列の7行目のセル
    Dim rngToColor As Range ' 色を塗りつぶす対象のセル範囲
    Dim ws As Worksheet
    Dim iCol As Integer ' 列インデックス

    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' F列からNG列までループ
    For iCol = 6 To ws.Range(strRangeAddress).Columns(ws.Range(strRangeAddress).Columns.Count).Column
        Set rngColumn7 = ws.Cells(7, iCol)

        ' 指定範囲の各列の2行目から102行目までループ
        For Each rngCell In ws.Range(ws.Cells(2, iCol), ws.Cells(102, iCol))
            ' セルが結合されている、または値が入力されている場合はスキップ
            If rngCell.MergeCells Or Not IsEmpty(rngCell.Value) Then Continue For

            ' 7行目に文字が入力されている場合
            If rngColumn7.Value <> "" Then
                If rngToColor Is Nothing Then
                    Set rngToColor = rngCell
                Else
                    Set rngToColor = Union(rngToColor, rngCell)
                End If
            End If
        Next rngCell
    Next iCol

    ' 色を塗りつぶす対象のセル範囲に背景色を設定
    If Not rngToColor Is Nothing Then
        rngToColor.Interior.Color = lngFillColor
    End If
End Sub

コメント