|
发表于 2015-3-17 14:00
|
显示全部楼层
本楼为最佳答案
- Sub 汇总求和()
- Dim sh, ar, x, k, br(1 To 65500, 1 To 2), r
- Range("a4:c" & [a65000].End(3).Row).ClearContents
- Set d = CreateObject("scripting.dictionary")
- For Each st In Sheets
- If st.Name <> "汇总" Then
- ar = st.Range("d4:h" & st.[d65500].End(3).Row)
- For x = 1 To UBound(ar)
- If d.exists(ar(x, 1)) Then
- r = d(ar(x, 1))
- br(r, 2) = br(r, 2) + ar(x, 5)
- Else
- k = k + 1: d(ar(x, 1)) = k
- br(k, 1) = ar(x, 1)
- br(k, 2) = ar(x, 5)
- End If
- Next
- End If
- Next
- [a4].Resize(k, 2) = br
- MsgBox "汇总完毕"
- End Sub
复制代码 |
|