|
发表于 2013-12-16 16:22
|
显示全部楼层
本楼为最佳答案
请楼主测试:- Sub 汇总()
- Dim ar, re
- Dim i As Integer, str As String, Cnt As Integer, R As Integer
- Dim d As Object
- Set d = CreateObject("Scripting.Dictionary")
- ar = Sheets(1).Range("A1").CurrentRegion
- ReDim re(1 To UBound(ar), 1 To UBound(ar, 2))
- For i = 2 To UBound(ar)
- str = ""
- For j = 1 To UBound(ar, 2)
- If j <> 5 Then str = str & ar(i, j)
- Next j
- If Not d.exists(str) Then
- Cnt = Cnt + 1
- d(str) = Cnt
- For j = 1 To UBound(ar, 2)
- If j <> 5 Then re(Cnt, j) = ar(i, j)
- Next j
- End If
- R = d(str)
- re(R, 5) = re(R, 5) + ar(i, 5)
- Next i
- Sheets(2).Range("A2:G65536").ClearContents
- Sheets(2).[a2].Resize(UBound(re), UBound(re, 2)) = re
- End Sub
复制代码 |
|