Sub Macro1() Dim arr, brr(), d As Object, temp$, m%, i&, j% With Sheets("Sheet2")
arr = .Range("A1:k" & .Range("A65536").End(xlUp).Row) End With Set d = CreateObject("scripting.dictionary") ReDim brr(1 To UBound(arr), 1 To 50) '其实可以动态这样也行 For i = 1 To UBound(arr) '数组ARR数据挨个循环 temp = arr(i, 1) & arr(i, 2) '把前2列条件连在一起当一个条件,这是多条件汇总的一个方法 If Not d.Exists(temp) Then '这里向下 一直到ELSE说明字典如果不存在就添加新字段,并把新的字段赋值给数组BRR m = m + 1 d(temp) = m For j = 1 To 11 brr(m, j) = arr(i, j) Next Else '这里到END IF 是存在字段就把字段后的值再BRR累加起来 For j = 3 To 11 brr(d(temp), j) = brr(d(temp), j) + arr(i, j) Next End If Next Range("A4").CurrentRegion.Offset(1, 0).ClearContents '清空 Range("A5").Resize(m, 100) = brr '把数组赋值给单元格 End Sub
|