|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 约定的童话 于 2020-1-16 14:40 编辑
搞定了没,楼主?
Sub 汇总()
Dim i, n, arr, brr, d As Object
Set d = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 4)
For i = 2 To UBound(arr)
t = arr(i, 1) & arr(i, 2) & arr(i, 4)
If Not d.exists(t) Then
n = n + 1
d(t) = n
For j = 1 To 4
brr(n, j) = arr(i, j)
Next
Else
m = d(t)
brr(m, 3) = brr(m, 3) + arr(i, 3)
End If
Next
[l2].Resize(UBound(brr), 4) = brr
End Sub
|
|