Sub prcFillOrClearGreyIfConditionMet()
' 条件に基づきセルの背景色を塗りつぶす、またはクリアする
Const strRangeAddress As String = "F2:NG102" ' アドレスの範囲
Const lngFillColor As Long = 15921906 ' 塗りつぶす色(薄いグレー色)
Dim rngCell As Range ' 処理対象のセル
Dim rngColumn7 As Range ' 各列の7行目のセル
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
If rngColumn7.Value <> "" Then
' 7行目に文字が入力されている場合、色を塗りつぶす
rngCell.Interior.Color = lngFillColor
ElseIf rngCell.Interior.Color = lngFillColor Then
' 7行目が空白で、セルが既に薄いグレー色の場合、色をクリア
rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
Next iCol
End Sub
コメント