[已解决]求助，按汇总生成新表 （高分悬赏）

yewei113

求助，按汇总生成新表

最佳答案

月排行榜 / 总排行榜

CheryBTL

2013-12-16 16:22

请楼主测试：

1. Sub 汇总()
   
2.     Dim ar, re
   
3.     Dim i As Integer, str As String, Cnt As Integer, R As Integer
   
4.     Dim d As Object
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     ar = Sheets(1).Range("A1").CurrentRegion
   
7.     ReDim re(1 To UBound(ar), 1 To UBound(ar, 2))
   
8.     For i = 2 To UBound(ar)
   
9.         str = ""
   
10.         For j = 1 To UBound(ar, 2)
    
11.             If j <> 5 Then str = str & ar(i, j)
    
12.         Next j
    
13.         If Not d.exists(str) Then
    
14.             Cnt = Cnt + 1
    
15.             d(str) = Cnt
    
16.             For j = 1 To UBound(ar, 2)
    
17.                 If j <> 5 Then re(Cnt, j) = ar(i, j)
    
18.             Next j
    
19.         End If
    
20.         R = d(str)
    
21.         re(R, 5) = re(R, 5) + ar(i, 5)
    
22.     Next i
    
23.     Sheets(2).Range("A2:G65536").ClearContents
    
24.     Sheets(2).[a2].Resize(UBound(re), UBound(re, 2)) = re
    
25. End Sub

复制代码

跳转到最佳答案楼层

sliang28

没有看见生成新表的条件是什么?{:2312:}

CheryBTL

sliang28 发表于 2013-12-16 15:53
没有看见生成新表的条件是什么?

学委，他这个是多条件字典就可以了 跟我们练习题一样

zhp3

看看数据透视表做的行不行？
以“供应商名称”升序排列的汇总结果。
求助.zip (12.42 KB, 下载次数: 11)

2013-12-16 16:20 上传

点击文件名下载附件

CheryBTL

请楼主测试：

1. Sub 汇总()
   
2.     Dim ar, re
   
3.     Dim i As Integer, str As String, Cnt As Integer, R As Integer
   
4.     Dim d As Object
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     ar = Sheets(1).Range("A1").CurrentRegion
   
7.     ReDim re(1 To UBound(ar), 1 To UBound(ar, 2))
   
8.     For i = 2 To UBound(ar)
   
9.         str = ""
   
10.         For j = 1 To UBound(ar, 2)
    
11.             If j <> 5 Then str = str & ar(i, j)
    
12.         Next j
    
13.         If Not d.exists(str) Then
    
14.             Cnt = Cnt + 1
    
15.             d(str) = Cnt
    
16.             For j = 1 To UBound(ar, 2)
    
17.                 If j <> 5 Then re(Cnt, j) = ar(i, j)
    
18.             Next j
    
19.         End If
    
20.         R = d(str)
    
21.         re(R, 5) = re(R, 5) + ar(i, 5)
    
22.     Next i
    
23.     Sheets(2).Range("A2:G65536").ClearContents
    
24.     Sheets(2).[a2].Resize(UBound(re), UBound(re, 2)) = re
    
25. End Sub

复制代码

上清宫主

就是按C列来汇总实收总价？

陈丹青

他是想把C列中相同的累加

yewei113

CheryBTL 发表于 2013-12-16 16:22
请楼主测试：

想问一下，这是按什么求和汇总的，（我的要求是按发－票－号求和汇总）
请把语句标注一下，我怕以后表格有变化时看不明白，
再有一个问题就是，你汇总后的发－票－号前面的０没有了，应该是，原来是什么样的汇总出来也要什么样的，谢谢，你这个基本是我想要的答案，帮忙再给修改一下，谢谢了

yewei113

上清宫主 发表于 2013-12-16 16:24
就是按C列来汇总实收总价？

是的就这样的

CheryBTL

yewei113 发表于 2013-12-17 09:10
想问一下，这是按什么求和汇总的，（我的要求是按发－票－号求和汇总）
请把语句标注一下，我怕以后表格 ...

就按总价之外的所有条件汇总的，若票号一样时，其它数据一样的话，就是按票号汇总了。