| 
    
     |  | ▼amatsuno さん: 
 よくみると、合計するのが、B列なのかC列なのか混乱しています。
 どっちでしょうか。
 
 
 Option Explicit
 
 Sub test()
 Dim dic1 As Object, dic2 As Object
 Dim c As Range
 Dim vk1 As String, vk2 As String
 
 Set dic1 = CreateObject("scripting.dictionary")
 Set dic2 = CreateObject("scripting.dictionary")
 
 With Worksheets("シート1")
 For Each c In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
 vk1 = c.Value
 vk2 = c.Offset(, 2).Text
 
 If IsDate(vk2) Then
 dic1(vk1) = dic1(vk1) + TimeValue(vk2)
 dic2(vk1) = dic2(vk1) + TimeValue(vk2)
 Else
 dic1(vk1) = TimeValue("23:59:58")
 End If
 Next
 
 .Cells(5).Resize(dic1.Count).Value = Application.Transpose(dic1.keys)
 .Cells(6).Resize(dic1.Count).Value = Application.Transpose(dic1.items)
 .Cells(7).Resize(dic2.Count).Value = Application.Transpose(dic2.keys)
 .Cells(8).Resize(dic2.Count).Value = Application.Transpose(dic2.items)
 End With
 
 End Sub
 
 |  |