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

yewei113

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

复制代码

这个汇总出来的是，如果发-票-号一样，其他不一样也会单独汇总，我想要的是，如果票号一样，其他不一样的，就随便取其中一行数据就行，不要单独再汇总一条了

最佳答案

月排行榜 / 总排行榜

CheryBTL

2013-12-17 15:11

那更简单了，看看是不是这个效果？

11111.rar (29.32 KB, 下载次数: 22)

2013-12-17 15:28 上传

点击文件名下载附件

跳转到最佳答案楼层

CheryBTL

数据里没有出现带0与不带0同时出现的数据呀，建议重新调整下附件

yewei113

CheryBTL 发表于 2013-12-17 10:34
数据里没有出现带0与不带0同时出现的数据呀，建议重新调整下附件

这是我们的全表，以后可能有几万行，所以区域给我设置大一点，最好给我注释一下，谢谢了

yewei113

这是最全的

CheryBTL

yewei113 发表于 2013-12-17 10:54
这是最全的

我的意思是，这里不存在前面0的问题呀，原来的代码仍然有效，
另外，数据多时会自动获取的。

yewei113

CheryBTL 发表于 2013-12-17 11:12
我的意思是，这里不存在前面0的问题呀，原来的代码仍然有效，
另外，数据多时会自动获取的。

上午网有问题，上不了附件，这个附件是我的表，你看它汇总出来的是有的票号好多行，我只要按票号汇总，如果其它列不一样随意取其中的一个就行

CheryBTL

那更简单了，看看是不是这个效果？

11111.rar (29.32 KB, 下载次数: 22)

2013-12-17 15:28 上传

点击文件名下载附件

yewei113

CheryBTL 发表于 2013-12-17 15:11
那更简单了，看看是不是这个效果？

哪个效果，没看到附件或代码呀

白雪高山

7楼看来太粗心了，忘记传附件了

yewei113

不是可能是发-票这个字眼不行，你不行就把那个压缩一下吧