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
コメント