|
发表于 2016-3-22 14:59
|
显示全部楼层
本楼为最佳答案
- Sub tt()
- Dim bt As Range
- arr = Sheet1.[a1].CurrentRegion
- Set d = CreateObject("scripting.dictionary")
- Set d1 = CreateObject("scripting.dictionary")
- Set bt = Sheet1.[a1:d1]
- For i = 2 To UBound(arr) - 1
- x = arr(i, 2)
- d1(x) = d1(x) + arr(i, 4)
- If Not d.exists(x) Then
- Set d(x) = Union(bt, Sheet1.Cells(i, 1).Resize(1, 4))
- Else
- Set d(x) = Union(d(x), Sheet1.Cells(i, 1).Resize(1, 4))
- End If
- Next
- Worksheets.Add after:=Sheets(Sheets.Count)
- With ActiveSheet
- For Each x In d.keys
- r = .[a65536].End(3).Row + 2
- If r = 3 Then r = 1
- d(x).Copy .Cells(r, 1)
- r = .[a65536].End(3).Row + 1
- .Cells(r, 1) = "合计"
- .Cells(r, 1).Resize(1, 3).Merge
- .Cells(r, 1).Resize(1, 3).HorizontalAlignment = xlCenter
- .Cells(r, 4) = d1(x)
- .HPageBreaks.Add Before:=.Cells(r + 1, 1)
- .Cells(r, 1).CurrentRegion.Borders.LineStyle = 1
- Next
- End With
- End Sub
复制代码 |
|