［シリーズ：ChatGPTを使ってExcelフル活用］②ピポットテーブルを使うより集計作業が劇的に時短！？

Sub CalculateData()

Dim wsExtract As Worksheet
Dim wsSummary As Worksheet
Dim LastRow As Long
Dim UniqueNumbers As Collection
Dim Num As Range, Cell As Range
Dim SumTimes As Double, CountTimes As Double

' シートを定義
Set wsExtract = ThisWorkbook.Sheets("抽出")

' ①「抽出」シートのE列に「滞在時間」を計算
wsExtract.Range("E1").Value = "滞在時間"
LastRow = wsExtract.Cells(wsExtract.Rows.Count, "A").End(xlUp).Row
For Each Cell In wsExtract.Range("E2:E" & LastRow)
    Cell.Value = Cell.Offset(0, -2).Value - Cell.Offset(0, -3).Value
    Cell.NumberFormat = "h:mm:ss"
Next Cell

' ②「集計結果」シートの作成とA列に「組人数」の一意のリストを生成
On Error Resume Next
Set wsSummary = ThisWorkbook.Sheets("集計結果")
On Error GoTo 0
If wsSummary Is Nothing Then
    Set wsSummary = ThisWorkbook.Sheets.Add(After:=wsExtract)
    wsSummary.Name = "集計結果"
End If

wsSummary.Cells.Clear
wsSummary.Range("A1").Value = "組人数"
Set UniqueNumbers = New Collection

On Error Resume Next
For Each Cell In wsExtract.Range("D2:D" & LastRow)
    UniqueNumbers.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

Dim i As Long
i = 2
For Each Num In UniqueNumbers
    wsSummary.Cells(i, 1).Value = Num
    i = i + 1
Next Num

' ③「集計結果」シートのB1セルに「平均滞在時間」を計算
wsSummary.Range("B1").Value = "平均滞在時間"
LastRow = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row
For Each Cell In wsSummary.Range("A2:A" & LastRow)
    SumTimes = 0
    CountTimes = 0
    For Each Num In wsExtract.Range("D2:D" & wsExtract.Cells(wsExtract.Rows.Count, "D").End(xlUp).Row)
        If Cell.Value = Num.Value Then
            SumTimes = SumTimes + Num.Offset(0, 1).Value
            CountTimes = CountTimes + 1
        End If
    Next Num
    If CountTimes > 0 Then
        Cell.Offset(0, 1).Value = SumTimes / CountTimes
        Cell.Offset(0, 1).NumberFormat = "h:mm:ss"
    End If
Next Cell

End Sub