Option Explicit
Public Sub 集計()
    Dim dicT1 As Object     'キー：担当者　値：Sheet2の行番号
    Dim dicT2 As Object     'キー：担当者＋日　値：True
    Dim lrow1 As Long               'Sheet1     最終行
    Dim lrow2 As Long: lrow2 = 3    'Sheet2　   最終行
    Dim key1 As String
    Dim key2 As String
    Dim sh1 As Worksheet    'Sheet1
    Dim sh2 As Worksheet    'Sheet2
    Dim row1 As Long
    Dim row2 As Long
    Set dicT1 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set dicT2 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set sh1 = Worksheets("sheet1")
    Set sh2 = Worksheets("sheet2")
    sh2.Rows("3:" & Rows.Count).ClearContents        'Sheet2 ３行以降をクリア
    lrow1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row 'Sheet1 最終行を求める
    For row1 = 2 To lrow1
        key1 = sh1.Cells(row1, "L").Value 'キー：担当者
        If dicT1.exists(key1) = False Then
            dicT1(key1) = lrow2
            sh2.Cells(lrow2, "B").Value = sh1.Cells(row1, "L").Value '担当者設定
            lrow2 = lrow2 + 1
        End If
        row2 = dicT1(key1)
        sh2.Cells(row2, "D").Value = sh2.Cells(row2, "D").Value + sh1.Cells(row1, "K").Value    '距離加算
        key2 = sh1.Cells(row1, "L").Value & "|" & sh1.Cells(row1, "B").Value    'キー：担当者＋日
        '当該日の最初の1回目のみ１加算する
        If dicT2.exists(key2) = False Then
            sh2.Cells(row2, "C").Value = sh2.Cells(row2, "C").Value + 1 '日数へ1加算
            dicT2(key2) = True
        End If
    Next
    MsgBox ("完了")
End Sub
 

T3B0aW9uIEV4cGxpY2l0ClB1YmxpYyBTdWIg6ZuG6KiIKCkKICAgIERpbSBkaWNUMSBBcyBPYmplY3QgICAgICfjgq3jg7zvvJrmi4XlvZPogIXjgIDlgKTvvJpTaGVldDLjga7ooYznlarlj7cKICAgIERpbSBkaWNUMiBBcyBPYmplY3QgICAgICfjgq3jg7zvvJrmi4XlvZPogIXvvIvml6XjgIDlgKTvvJpUcnVlCiAgICBEaW0gbHJvdzEgQXMgTG9uZyAgICAgICAgICAgICAgICdTaGVldDEgICAgIOacgOe1guihjAogICAgRGltIGxyb3cyIEFzIExvbmc6IGxyb3cyID0gMyAgICAnU2hlZXQy44CAICAg5pyA57WC6KGMCiAgICBEaW0ga2V5MSBBcyBTdHJpbmcKICAgIERpbSBrZXkyIEFzIFN0cmluZwogICAgRGltIHNoMSBBcyBXb3Jrc2hlZXQgICAgJ1NoZWV0MQogICAgRGltIHNoMiBBcyBXb3Jrc2hlZXQgICAgJ1NoZWV0MgogICAgRGltIHJvdzEgQXMgTG9uZwogICAgRGltIHJvdzIgQXMgTG9uZwogICAgU2V0IGRpY1QxID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRGljdGlvbmFyeSIpICcg6YCj5oOz6YWN5YiX44Gu5a6a576pCiAgICBTZXQgZGljVDIgPSBDcmVhdGVPYmplY3QoIlNjcmlwdGluZy5EaWN0aW9uYXJ5IikgJyDpgKPmg7PphY3liJfjga7lrprnvqkKICAgIFNldCBzaDEgPSBXb3Jrc2hlZXRzKCJzaGVldDEiKQogICAgU2V0IHNoMiA9IFdvcmtzaGVldHMoInNoZWV0MiIpCiAgICBzaDIuUm93cygiMzoiICYgUm93cy5Db3VudCkuQ2xlYXJDb250ZW50cyAgICAgICAgJ1NoZWV0MiDvvJPooYzku6XpmY3jgpLjgq/jg6rjgqIKICAgIGxyb3cxID0gc2gxLkNlbGxzKFJvd3MuQ291bnQsICJCIikuRW5kKHhsVXApLlJvdyAnU2hlZXQxIOacgOe1guihjOOCkuaxguOCgeOCiwogICAgRm9yIHJvdzEgPSAyIFRvIGxyb3cxCiAgICAgICAga2V5MSA9IHNoMS5DZWxscyhyb3cxLCAiTCIpLlZhbHVlICfjgq3jg7zvvJrmi4XlvZPogIUKICAgICAgICBJZiBkaWNUMS5leGlzdHMoa2V5MSkgPSBGYWxzZSBUaGVuCiAgICAgICAgICAgIGRpY1QxKGtleTEpID0gbHJvdzIKICAgICAgICAgICAgc2gyLkNlbGxzKGxyb3cyLCAiQiIpLlZhbHVlID0gc2gxLkNlbGxzKHJvdzEsICJMIikuVmFsdWUgJ+aLheW9k+iAheioreWumgogICAgICAgICAgICBscm93MiA9IGxyb3cyICsgMQogICAgICAgIEVuZCBJZgogICAgICAgIHJvdzIgPSBkaWNUMShrZXkxKQogICAgICAgIHNoMi5DZWxscyhyb3cyLCAiRCIpLlZhbHVlID0gc2gyLkNlbGxzKHJvdzIsICJEIikuVmFsdWUgKyBzaDEuQ2VsbHMocm93MSwgIksiKS5WYWx1ZSAgICAn6Led6Zui5Yqg566XCiAgICAgICAga2V5MiA9IHNoMS5DZWxscyhyb3cxLCAiTCIpLlZhbHVlICYgInwiICYgc2gxLkNlbGxzKHJvdzEsICJCIikuVmFsdWUgICAgJ+OCreODvO+8muaLheW9k+iAhe+8i+aXpQogICAgICAgICflvZPoqbLml6Xjga7mnIDliJ3jga4x5Zue55uu44Gu44G/77yR5Yqg566X44GZ44KLCiAgICAgICAgSWYgZGljVDIuZXhpc3RzKGtleTIpID0gRmFsc2UgVGhlbgogICAgICAgICAgICBzaDIuQ2VsbHMocm93MiwgIkMiKS5WYWx1ZSA9IHNoMi5DZWxscyhyb3cyLCAiQyIpLlZhbHVlICsgMSAn5pel5pWw44G4MeWKoOeulwogICAgICAgICAgICBkaWNUMihrZXkyKSA9IFRydWUKICAgICAgICBFbmQgSWYKICAgIE5leHQKICAgIE1zZ0JveCAoIuWujOS6hiIpCkVuZCBTdWIK