アクティブシートから特定の書式のセルの数をカウントするマクロ

つくるもの

作業するときに、エクセルでメモを残しながらやっている。 セルの書式毎に「疑問」とか「解決済み」とかタグをつけながらやっている。 発散してくると、「疑問点何個残ってるんだっけ？」となるので集計したい。

いつもの作業イメージ

いつもの作業イメージ

マクロの完成イメージ

マクロの完成イメージ

コード

'
' アクティブシートから特定の書式のセルの数をカウントするマクロ
'

Sub CountCellsByCellStyleInActiveSheet()
    '変数定義
    Dim strA As String 'Aセルの意味
    Dim strB As String 'Bセルの意味
    Dim strC As String 'Cセルの意味
    
    Dim countColorA As Long ' Aセルの色を表す変数
    Dim countColorB As Long ' Bのセルの色を表す変数
    Dim countColorC As Long ' Cのセルの色を表す変数

    Dim countA As Long ' Aセルの数をカウントするための変数
    Dim countB As Long ' Bのセルの数をカウントするための変数
    Dim countC As Long ' Cのセルの数をカウントするための変数
    
    Dim cell As Range ' セルを表す変数
    
    Dim cellA As Range 'Aセルのカウント数出力場所
    Dim cellB As Range 'Bセルのカウント数出力場所
    Dim cellC As Range 'Cセルのカウント数出力場所
    
    '変数初期化
    countA = 0 ' セルの数の初期化
    countB = 0 ' セルの数の初期化
    countC = 0 ' セルの数の初期化
    
    ' **** config ***
    'A,B,Cの意味
    strA = "疑問"
    strB = "Todo"
    strC = "解決"
    
    'A,B,Cの色
    countColorA = RGB(255, 235, 156) ' Aのセルの色を変数に格納
    countColorB = RGB(255, 199, 206) ' Bのセルの色を変数に格納
    countColorC = RGB(198, 239, 206) ' Cのセルの色を変数に格納
    
    'A,B,Cのカウント結果出力場所
    Set cellA = Range("G1")
    Set cellB = Range("I1")
    Set cellC = Range("K1")
    
    ' ***************
    
    For Each cell In ActiveSheet.UsedRange
        ' 背景色がAのセルの場合、カウントする
        If cell.Interior.Color = countColorA Then
        countA = countA + 1
        ' 背景色がBのセルの場合、カウントする
        ElseIf cell.Interior.Color = countColorB Then
        countB = countB + 1
        ' 背景色がCのセルの場合、カウントする
        ElseIf cell.Interior.Color = countColorC Then
        countC = countC + 1
        End If
    Next cell
    
    '見出しの分だけcount結果を引き算
    countA = countA - 1
    countB = countB - 1
    countC = countC - 1
    
    ' カウント結果をセルへ書き込み
    cellA.Value = countA
    cellB.Value = countB
    cellC.Value = countC
    
   
    ' カウントしたセルの数をメッセージボックスで表示
    MsgBox "セルを集計しました" & vbCrLf _
            & strA & ": " & countA & vbCrLf _
            & strB & ": " & countB & vbCrLf _
            & strC & ": " & countC

End Sub

感想

VBAカスタマイズがなかなか楽しい。