[已解决]Excel用VBA进行分类、按月汇总统计，求指点

hxgfkfb

Book11.rar (12.07 KB, 下载次数: 10)

2016-4-21 10:21 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-21 10:52

1. Sub 统计()
   
2.     x = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     ReDim brr(1 To UBound(arr), 1 To 26)
   
6.     For i = 3 To UBound(arr)
   
7.         xm = arr(i, 5) '项目
   
8.         yf = Month(arr(i, 2))
   
9.         c = InStr(x, xm) + 2 '项目在brr中对应的列
   
10.         brr(i - 2, 1) = arr(i, 2)
    
11.         brr(i - 2, 2) = arr(i, 3)
    
12.         brr(i - 2, c) = arr(i, 6)
    
13.         xkey = xm & yf & "月合计"
    
14.         d(xkey) = d(xkey) + arr(i, 6)
    
15.     Next
    
16.    
    
17.     With Sheet2
    
18.         .[a4:z1000] = ""
    
19.         .[a4].Resize(i - 2, 26) = brr
    
20.     End With
    
21.    
    
22.     With Sheet3
    
23.         .[b4:k18] = ""
    
24.         arr = .[a3:k18]
    
25.         For i = 2 To UBound(arr)
    
26.             For j = 2 To UBound(arr, 2)
    
27.                 xkey = arr(i, 1) & arr(1, j)
    
28.                 arr(i, j) = d(xkey)
    
29.             Next
    
30.         Next
    
31.         .[a3:k18] = arr
    
32.     End With
    
33. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 统计()
   
2.     x = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     ReDim brr(1 To UBound(arr), 1 To 26)
   
6.     For i = 3 To UBound(arr)
   
7.         xm = arr(i, 5) '项目
   
8.         yf = Month(arr(i, 2))
   
9.         c = InStr(x, xm) + 2 '项目在brr中对应的列
   
10.         brr(i - 2, 1) = arr(i, 2)
    
11.         brr(i - 2, 2) = arr(i, 3)
    
12.         brr(i - 2, c) = arr(i, 6)
    
13.         xkey = xm & yf & "月合计"
    
14.         d(xkey) = d(xkey) + arr(i, 6)
    
15.     Next
    
16.    
    
17.     With Sheet2
    
18.         .[a4:z1000] = ""
    
19.         .[a4].Resize(i - 2, 26) = brr
    
20.     End With
    
21.    
    
22.     With Sheet3
    
23.         .[b4:k18] = ""
    
24.         arr = .[a3:k18]
    
25.         For i = 2 To UBound(arr)
    
26.             For j = 2 To UBound(arr, 2)
    
27.                 xkey = arr(i, 1) & arr(1, j)
    
28.                 arr(i, j) = d(xkey)
    
29.             Next
    
30.         Next
    
31.         .[a3:k18] = arr
    
32.     End With
    
33. End Sub
    

复制代码

hxgfkfb

grf1973 发表于 2016-4-21 10:52

VBA分类、按月汇总统计.rar (19.64 KB, 下载次数: 6)

2016-4-21 12:57 上传

点击文件名下载附件

为什么“项目2”中的原字母我改成了汉字就不能进行分类统计了呢？谢谢

grf1973

请看附件。区别在代码有体现。

hzweirui

VBA分类、按月汇总统计

13641921957

正在学习VBA，各种找不到北感觉。