辞書のキーと一致した数をカウントする方法

 Sub CountTrueFalsePerKey()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 対象のシート名を指定

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' A列の最終行を取得

    Dim dataRange As Range
    Set dataRange = ws.Range("A1:F" & lastRow)

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    Dim key As String
    Dim value As Variant

    ' 初期化: 辞書にキーと初期値の配列を設定
    For i = 2 To lastRow ' ヘッダー行を除外するため2行目からスタート
        key = ws.Cells(i, 1).Value ' A列のキー

        If Not dict.exists(key) Then
            dict.Add key, Array(0, 0) ' 初期値 (Trueの数, Falseの数)
        End If
    Next i

    ' カウント: TrueとFalseの数をカウント
    For i = 2 To lastRow
        key = ws.Cells(i, 1).Value
        value = ws.Cells(i, 4).Value ' D列の値

        If dict.exists(key) Then
            Dim currentArray() As Variant
            currentArray = dict(key)

            If value = True Then
                currentArray(0) = currentArray(0) + 1
            ElseIf value = False Then
                currentArray(1) = currentArray(1) + 1
            End If

            ' 更新した配列を再度ディクショナリにセット
            dict(key) = currentArray
        End If
    Next i

    ' 結果の表示
    Dim k As Variant
    For Each k In dict.Keys
        Debug.Print "Key: " & k & " - True: " & dict(k)(0) & ", False: " & dict(k)(1)
    Next k

End Sub