条件付き書式で表示が変わったセルの背景色をVBAでチェックするには

条件付き書式で背景色が変更されている行に対して、任意の背景色を持つセルの列だけを表示したかったので次のようなコードを書いてみたんですが、.Interior.Colorの値が16777215(=vbWhite )になってしまい、今更こんなことでつまづくのかと苦笑してしまいました。

実際のシートは、このような感じで時間帯に応じて背景色を付けています。例えば13:32のセルを選択しておいて、同色の列だけを表示させることで同時刻帯の比較がしたかったわけです。

 

f:id:gungnir46:20191222020509p:plain

 

↓ 

f:id:gungnir46:20191222020703p:plain

 

Public Sub 同時刻帯表示()

    Dim xCell   As Excel.Range
    Dim iColor  As Long
  
    iColor = ActiveCell.Interior.Color
    If iColor = vbWhite Then  '<== iColorの値がvbWhiteになってしまう
        MsgBox "背景色に色がついたセルをクリックしてから実行してください", vbInformation
        Exit Sub
    End If 

    Set xCell = Sheet1.Range("A2")
    Do While xCell <> ""
        If (xCell.Interior.Color = iColor) Then
            xCell.ColumnWidth = 8.38
        Else
            xCell.ColumnWidth = 0
        End If
        Set xCell = xCell.Offset(0, 1)
    Loop 

End Sub 

 

この問題を回避するには、.DisplayFormat.Interior.Colorを参照すればよいということらしいです。フォントの色は、.DisplayFormat.Font.Colorを参照。それにしても、こういう例外処理は勘弁して欲しいですね。

Public Sub 同時刻帯表示()
    Dim xCell   As Excel.Range
    Dim iColor  As Long
  
    iColor = ActiveCell.DisplayFormat.Interior.Color
    If iColor = vbWhite Then
        MsgBox "背景色に色がついたセルをクリックしてから実行してください", vbInformation
        Exit Sub
    End If 

    Set xCell = Sheet1.Range("A2")
    Do While xCell <> ""
        If (xCell.DisplayFormat.Interior.Color = iColor) Then
            xCell.ColumnWidth = 8.38
        Else
            xCell.ColumnWidth = 0
        End If
        Set xCell = xCell.Offset(0, 1)
    Loop 

End Sub 

※実際のコードは"A2"とかSheet1みたいなハードコードはしてません。もうちょっと賢く抽象化してあります。ここでは読みやすさを優先してハードコードしてあります。