本帖最后由 风中稻草人 于 2019-11-23 11:07 编辑
Sub 统计()
Dim i As Integer, j As Integer, k As Integer
Dim EndRow As Integer, dic As Object, arr, brr()
EndRow = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:I" & EndRow).Value
ReDim brr(1 To UBound(arr), 1 To 8)
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
If Not dic.Exists(arr(i, 1)) Then
j = j + 1
dic(arr(i, 1)) = j
brr(j, 1) = arr(i, 1)
brr(j, 2) = arr(i, 2)
brr(j, 3) = arr(i, 3)
brr(j, 4) = arr(i, 4)
brr(j, 5) = arr(i, 5)
brr(j, 6) = arr(i, 6)
brr(j, 7) = arr(i, 8)
brr(j, 8) = arr(i, 9)
Else
k = dic(arr(i, 1))
brr(k, 5) = brr(k, 5) + arr(i, 5)
brr(k, 6) = brr(k, 6) + arr(i, 6)
brr(k, 7) = brr(k, 7) + arr(i, 8)
brr(k, 8) = brr(k, 8) + arr(i, 9)
End If
Next
ActiveSheet.UsedRange.Offset(1, 11).Clear
Cells(2, "L").Resize(j, 8) = brr
End Sub
|