如何通过VBA汇总EXCEL工作表中的数据

yah760911

赵老师,只加总:"J"列与"L"列,其它的为固定的.

zhaogang1960

yah760911 发表于 2012-6-5 08:30
赵老师,只加总:"J"列与"L"列,其它的为固定的.

1. Sub Macro1()
   
2.     Dim arr, d As Object, i&, j&, m&, s$
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("A1").CurrentRegion
   
5.     m = 1
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 4) & arr(i, 5) & arr(i, 6)
   
8.         t = d(s)
   
9.         If t = "" Then
   
10.             m = m + 1
    
11.             d(s) = m
    
12.             arr(m, 1) = m - 1
    
13.             For j = 2 To UBound(arr, 2)
    
14.                 arr(m, j) = arr(i, j)
    
15.             Next
    
16.         Else
    
17.             arr(t, 10) = arr(t, 10) + arr(i, 10)
    
18.             arr(t, 12) = arr(t, 12) + arr(i, 12)
    
19.         End If
    
20.     Next
    
21.     With Sheets("Sheet2") '写到Sheet2
    
22.         .Cells.ClearContents
    
23.         .[a1].Resize(m, j - 1) = arr
    
24.     End With
    
25. End Sub
    

复制代码

zhaogang1960

请看附件
表1.rar (13.77 KB, 下载次数: 69)

2012-6-6 15:27 上传

点击文件名下载附件

yah760911

不是我想要的结果,我要的结果是在本工作表里,不是写入sheet2里.

zuiaidh2004

路过学习。。。

zhaogang1960

yah760911 发表于 2012-6-7 09:14
不是我想要的结果,我要的结果是在本工作表里,不是写入sheet2里.

写到原来的区域？

1. Sub Macro1()
   
2.     Dim arr, d As Object, i&, j&, m&, s$
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("A1").CurrentRegion
   
5.     m = 1
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 4) & arr(i, 5) & arr(i, 6)
   
8.         t = d(s)
   
9.         If t = "" Then
   
10.             m = m + 1
    
11.             d(s) = m
    
12.             arr(m, 1) = m - 1
    
13.             For j = 2 To UBound(arr, 2)
    
14.                 arr(m, j) = arr(i, j)
    
15.             Next
    
16.         Else
    
17.             arr(t, 10) = arr(t, 10) + arr(i, 10)
    
18.             arr(t, 12) = arr(t, 12) + arr(i, 12)
    
19.         End If
    
20.     Next
    
21.     Cells.ClearContents
    
22.     [a1].Resize(m, j - 1) = arr
    
23. End Sub
    

复制代码

yah760911

搞定,感谢赵老师的帮助,谢谢!!!

homewin

xmyjk 发表于 2011-5-22 18:32

看了xmyjk 兄的方法，本人学识浅陋，有些代码看不明白，想请教xmyjk 兄解析一下，不胜感激：
（1）d(arr(i, 1) & arr(i, 2)) = d(arr(i, 1) & arr(i, 2)) + arr(i, 3)这样做的目的是什么？字典里面不是根据keys和Items来识别的吗，到底哪一列是keys，那一列是item？
（2）Erase arr有什么用处，下面代码也用到arr，后面的arr数据不会覆盖前面的吗？
（3）arr(i + 1, j + 1) = d(arr(i + 1, 1) & arr(1, j + 1))这句代码不明白，汇总的数据是怎样生成的？
最后，盼xmyjk 兄能够指点，谢谢！

千百次回眸

xmyjk 发表于 2011-5-22 22:11
呃，不客气，不用激动，好好学习天天向上即可，很快你也会都懂的，都不是些很难的东西。
也欢迎新人啦 ...

学习了，谢谢大神。。

andylord3721

xmyjk 发表于 2011-5-22 18:32

你好，有个问题请教一下，使用您的代码可以执行没有报错，但是当我把arr=Sheet1.Range...改为arr=Worksheets("sheet1").Range...时为什么会提示运行时错误'13':类型不匹配呢？