[已解决]求助一个类似于数据透视表的代码

秋意正浓

要求：从图片1的效果变成图片2的效果。
详见附件。谢谢。PS:图片2的日期和类别是事先存在的，所以，汇总的时候，不能将日期和类别也汇总过来覆盖了原来的日期和类别，谢谢各位

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-9-7 15:24

一个类似于数据透视表功能的代码求助.rar (16.55 KB, 下载次数: 18)

2012-9-7 15:24 上传

点击文件名下载附件

跳转到最佳答案楼层

hwc2ycy

1. Sub tj()
   
2.     Dim rg As Range
   
3.     Dim arr
   
4.     Dim d As New Dictionary
   
5.     Dim i&
   
6.     Application.ScreenUpdating = False
   
7.    
   
8.     Worksheets("sheet1").Activate
   
9.     Set rg = Range(Range("a1"), Range("a1").End(xlDown)).Resize(, 3)
   
10.     arr = rg.Value
    
11.    
    
12.     For i = 2 To UBound(arr)
    
13.         If Not d.Exists(arr(i, 1) & arr(i, 2)) Then
    
14.             d.Add arr(i, 1) & arr(i, 2), arr(i, 3)
    
15.         Else
    
16.             d(arr(i, 1) & arr(i, 2)) = d(arr(i, 1) & arr(i, 2)) + arr(i, 3)
    
17.         End If
    
18.     Next
    
19.    
    
20.     Worksheets("sheet2").Activate
    
21.     Range("c:c").ClearContents
    
22.     Set rg = Range(Range("a1"), Range("a1").End(xlDown)).Resize(, 3)
    
23.     arr = rg
    
24.     For i = 2 To UBound(arr)
    
25.         arr(i, 3) = d(arr(i, 1) & arr(i, 2))
    
26.     Next
    
27.     rg = arr
    
28. End Sub
    

复制代码

hwc2ycy

一个类似于数据透视表功能的代码求助.rar (16.55 KB, 下载次数: 18)

2012-9-7 15:24 上传

点击文件名下载附件