＜実例＞データベースを集計する方法

Sub monthly_Totalization()
    Dim table As ListObject
    Dim dicts_Lists As New Dictionary
    Dim r As Range
    Dim ws As Worksheet
    Dim input1, input2 As String
    Dim input_Date1, input_Date2, date_ As Date
    Dim date_Span, date_Spans() As Variant
    Dim i, j As Long
    Dim l As Variant
    Dim first_day, last_day As Date
    
    'インプットボックスで日付を入力する。
    '必要なのは年と月なので日は1日にする。
    input1 = InputBox("yyyymm型で入力してください")
    If Len(input1) <> 6 Then
        MsgBox ("最初から入力してください")
        Exit Sub
    Else
        input_Date1 = CDate(Left(input1, 4) & "/" & Mid(input1, 5, 2) & "/" & "01")
    End If
    
    
    input2 = InputBox("yyyymm型で入力してください")
    If Len(input2) <> 6 Then
        MsgBox ("最初から入力してください")
        Exit Sub
    Else
        input_Date2 = CDate(Left(input2, 4) & "/" & Mid(input2, 5, 2) & "/" & "01")
    End If
    
    date_ = input_Date1
    Do While date_ <= input_Date2
        ReDim Preserve date_Spans(i)
        date_Spans(i) = date_
        date_ = DateAdd("m", 1, date_)
        i = i + 1
    Loop
    
    
    Set table = ThisWorkbook.Worksheets(1).ListObjects(1)
    
    'ユニークリストの作成
    For Each r In table.ListColumns("部門").DataBodyRange
        On Error Resume Next
        dicts_Lists.Add r.Value, r.Value
        On Error GoTo 0
    Next

    'アウトプット用のワークシート作成(ダブらないように前回のシートを消す）
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "部門別検体数" Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next
    Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    Set ws = ActiveSheet
    ws.Name = "部門別検体数"
    
    '表の横軸（月別）入力
    i = 2
    For Each date_Span In date_Spans
        ws.Cells(1, i).Value = Format(date_Span, "yyyy/mm")
        i = i + 1
    Next
    
    '表の縦軸（部門別）を入力しながら、検体数をカウントしていく。
    i = 2
    For Each l In dicts_Lists
        ws.Cells(i, 1).Value = l
        j = 2
        For Each date_Span In date_Spans
            first_day = date_Span
            last_day = DateAdd("d", -1, DateAdd("m", 1, date_Span))
            ws.Cells(i, j).Value = Application.WorksheetFunction.CountIfs( _
                                                    table.ListColumns("試験日").DataBodyRange, ">=" & first_day, _
                                                    table.ListColumns("試験日").DataBodyRange, "<=" & last_day, _
                                                    table.ListColumns("部門").DataBodyRange, l)
            j = j + 1
        Next
        i = i + 1
    Next
End Sub