[已解决]如何统计合并不同月份数据

飞云流水

如何统计合并不同月份数据，比如2月份1组的生产和出库的数量不一样，麻烦大师帮帮我，不要用透视表要VB代码，多谢！

最佳答案

月排行榜 / 总排行榜

liuguansky

2011-12-31 09:44

1. Sub jUsttESt()
   
2. '引用VBE下工具－引用－ms scripting runtime
   
3.     Dim D As New Dictionary, Arr, i&, ArrT(), S$, K1$, K&
   
4.     With Worksheets("数据录入")
   
5.         Arr = .Range("b2:r" & .Cells(.Rows.Count, 2).End(3).Row).Value
   
6.     End With
   
7.     For i = 1 To UBound(Arr)
   
8.         S = Format(Arr(i, 1), "yyyy年m月份")
   
9.         K1 = S & Arr(i, 3)
   
10.         If D.Exists(K1) Then
    
11.             ArrT(13, D(K1)) = ArrT(13, D(K1)) + 1
    
12.             ArrT(4, D(K1)) = ArrT(4, D(K1)) + Arr(i, 6)
    
13.             ArrT(5, D(K1)) = ArrT(5, D(K1)) + Arr(i, 7)
    
14.             ArrT(6, D(K1)) = ArrT(6, D(K1)) + Arr(i, 8)
    
15.             ArrT(7, D(K1)) = ArrT(7, D(K1)) + Arr(i, 9)
    
16.             If Len(Arr(i, 15)) Then
    
17.                 ArrT(12, D(K1)) = ArrT(12, D(K1)) + Arr(i, 17)
    
18.             End If
    
19.         Else
    
20.             K = K + 1: ReDim Preserve ArrT(1 To 13, 1 To K)
    
21.             D.Add K1, K: ArrT(2, K) = S: ArrT(1, K) = K
    
22.             ArrT(3, K) = Arr(i, 3): ArrT(13, D(K1)) = 1
    
23.             ArrT(4, D(K1)) = Arr(i, 6): ArrT(5, D(K1)) = Arr(i, 7)
    
24.             ArrT(6, D(K1)) = Arr(i, 8): ArrT(7, D(K1)) = Arr(i, 9)
    
25.             If Len(Arr(i, 15)) Then ArrT(12, K) = Arr(i, 17)
    
26.         End If
    
27.         S = Format(Arr(i, 10), "yyyy年m月份")
    
28.         K1 = S & Arr(i, 3)
    
29.         If D.Exists(K1) Then
    
30.             ArrT(8, D(K1)) = ArrT(8, D(K1)) + Arr(i, 11)
    
31.             ArrT(9, D(K1)) = ArrT(9, D(K1)) + Arr(i, 12)
    
32.             ArrT(10, D(K1)) = ArrT(10, D(K1)) + Arr(i, 13)
    
33.             ArrT(11, D(K1)) = ArrT(11, D(K1)) + Arr(i, 14)
    
34.         Else
    
35.             K = K + 1: ReDim Preserve ArrT(1 To 13, 1 To K)
    
36.             D.Add K1, K: ArrT(2, K) = S: ArrT(3, K) = Arr(i, 3): ArrT(1, K) = K
    
37.             ArrT(8, D(K1)) = Arr(i, 11): ArrT(9, D(K1)) = Arr(i, 12)
    
38.             ArrT(10, D(K1)) = Arr(i, 13): ArrT(11, D(K1)) = Arr(i, 14)
    
39.         End If
    
40.     Next
    
41.     With Worksheets("统计表")
    
42.         .Range("A3:m" & .Rows.Count).ClearContents
    
43.         .Range("A3").Resize(K, 13) = Application.Transpose(ArrT)
    
44.         .Range("b3").Resize(K, 12).Sort key1:=.Range("c3"), Order1:=xlAscending, _
    
45.                 key2:=.Range("b3"), Order1:=xlAscending, Header:=xlNo
    
46.     End With
    
47.     Set D = Nothing
    
48. End Sub
    

复制代码

统计不同月份数据.rar (23.87 KB, 下载次数: 39)

2011-12-31 09:43 上传

点击文件名下载附件
请参见附件效果。[删除了辅助列]

跳转到最佳答案楼层

菜鸟锐

你里面的附件的数据比较多，我想做起来要花费一些心思。

飞云流水

菜鸟锐 发表于 2011-12-31 09:12
你里面的附件的数据比较多，我想做起来要花费一些心思。

多谢，麻烦你看看吧！

liuguansky

1. Sub jUsttESt()
   
2. '引用VBE下工具－引用－ms scripting runtime
   
3.     Dim D As New Dictionary, Arr, i&, ArrT(), S$, K1$, K&
   
4.     With Worksheets("数据录入")
   
5.         Arr = .Range("b2:r" & .Cells(.Rows.Count, 2).End(3).Row).Value
   
6.     End With
   
7.     For i = 1 To UBound(Arr)
   
8.         S = Format(Arr(i, 1), "yyyy年m月份")
   
9.         K1 = S & Arr(i, 3)
   
10.         If D.Exists(K1) Then
    
11.             ArrT(13, D(K1)) = ArrT(13, D(K1)) + 1
    
12.             ArrT(4, D(K1)) = ArrT(4, D(K1)) + Arr(i, 6)
    
13.             ArrT(5, D(K1)) = ArrT(5, D(K1)) + Arr(i, 7)
    
14.             ArrT(6, D(K1)) = ArrT(6, D(K1)) + Arr(i, 8)
    
15.             ArrT(7, D(K1)) = ArrT(7, D(K1)) + Arr(i, 9)
    
16.             If Len(Arr(i, 15)) Then
    
17.                 ArrT(12, D(K1)) = ArrT(12, D(K1)) + Arr(i, 17)
    
18.             End If
    
19.         Else
    
20.             K = K + 1: ReDim Preserve ArrT(1 To 13, 1 To K)
    
21.             D.Add K1, K: ArrT(2, K) = S: ArrT(1, K) = K
    
22.             ArrT(3, K) = Arr(i, 3): ArrT(13, D(K1)) = 1
    
23.             ArrT(4, D(K1)) = Arr(i, 6): ArrT(5, D(K1)) = Arr(i, 7)
    
24.             ArrT(6, D(K1)) = Arr(i, 8): ArrT(7, D(K1)) = Arr(i, 9)
    
25.             If Len(Arr(i, 15)) Then ArrT(12, K) = Arr(i, 17)
    
26.         End If
    
27.         S = Format(Arr(i, 10), "yyyy年m月份")
    
28.         K1 = S & Arr(i, 3)
    
29.         If D.Exists(K1) Then
    
30.             ArrT(8, D(K1)) = ArrT(8, D(K1)) + Arr(i, 11)
    
31.             ArrT(9, D(K1)) = ArrT(9, D(K1)) + Arr(i, 12)
    
32.             ArrT(10, D(K1)) = ArrT(10, D(K1)) + Arr(i, 13)
    
33.             ArrT(11, D(K1)) = ArrT(11, D(K1)) + Arr(i, 14)
    
34.         Else
    
35.             K = K + 1: ReDim Preserve ArrT(1 To 13, 1 To K)
    
36.             D.Add K1, K: ArrT(2, K) = S: ArrT(3, K) = Arr(i, 3): ArrT(1, K) = K
    
37.             ArrT(8, D(K1)) = Arr(i, 11): ArrT(9, D(K1)) = Arr(i, 12)
    
38.             ArrT(10, D(K1)) = Arr(i, 13): ArrT(11, D(K1)) = Arr(i, 14)
    
39.         End If
    
40.     Next
    
41.     With Worksheets("统计表")
    
42.         .Range("A3:m" & .Rows.Count).ClearContents
    
43.         .Range("A3").Resize(K, 13) = Application.Transpose(ArrT)
    
44.         .Range("b3").Resize(K, 12).Sort key1:=.Range("c3"), Order1:=xlAscending, _
    
45.                 key2:=.Range("b3"), Order1:=xlAscending, Header:=xlNo
    
46.     End With
    
47.     Set D = Nothing
    
48. End Sub
    

复制代码

统计不同月份数据.rar (23.87 KB, 下载次数: 39)

2011-12-31 09:43 上传

点击文件名下载附件
请参见附件效果。[删除了辅助列]

飞云流水

liuguansky 发表于 2011-12-31 09:44
请参见附件效果。[删除了辅助列]

真的很好，学习了，谢谢！

飞云流水

liuguansky 发表于 2011-12-31 09:44
请参见附件效果。[删除了辅助列]

老师：帮我再看看这样如何统计，数据改了后不知怎样改代码，谢谢了（统计条件为4个）

飞云流水

飞云流水 发表于 2012-1-1 16:46
老师：帮我再看看这样如何统计，数据改了后不知怎样改代码，谢谢了（统计条件为4个）

老师：帮我再看看这样如何统计，数据改了后不知怎样改代码，谢谢了