­ã´£³¡ªL

°ò¥»¦r¨åÀ³¥Î..¤§«e«Ü¦h°Ý©«³£¦³¥Î¹L, ¥i¨£ÁÙ¬O¨S¦³¥Î¤ß¥h²z¸Ñ//
¦³¨Ç°ÝÃDÁÙ¬O¥i¥H¦Û¦æ¥h¸Ñ¨Mªº///
Sub Test_a1()
Dim Arr, xD, T$, i&, j&, N&
Sheets("Result").UsedRange.Offset(10).EntireRow.Delete
[Result!a10:i10] = ""
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Data!i1], [data!a65536].End(3))
For i = 10 To UBound(Arr)
    If Not IsNumeric(Arr(i, 1) & "") Then GoTo i01
    T = Arr(i, 2) & "\" & Arr(i, 4) & "\" & Arr(i, 5)
    If xD(T) = 0 Then
       N = N + 1: xD(T) = N: Arr(N, 1) = N
       For j = 2 To UBound(Arr, 2): Arr(N, j) = Arr(i, j): Next
    Else
       j = xD(T)
       Arr(j, 6) = Arr(j, 6) + Arr(i, 6)
       Arr(j, 8) = Arr(j, 8) + Arr(i, 8)
    End If
i01: Next i
If N = 0 Then Exit Sub
With [Result!a10:i10].Resize(N)
     .Rows(1).Copy .Cells
     .Value = Arr
     .Columns(2).Resize(, 8).Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlNo
End With
End Sub