计算汇总数并删除汇总金额为零的记录

dj1971mahuateng

十几万行的数据，要汇总A列单元格的汇总数，并删除汇总金额为零的。
我试过用sumif函数，但是计算运行很慢，用数据透视表汇总后再用VLOOKUP函数反写回去，之后再删除汇总金额为零的数据，也很慢，而且很容易出错。求大神出手相助！

dj1971mahuateng

刚才附件没挂上

dj1971mahuateng

谢谢3楼楼主！非常感谢！
运行之后，可以得到合计金额不为零的数据，不过能不能麻烦您再帮我看一下，我想要完整的一条数据，就是保留下来的数据包含下列内容：
编码        " 金额        2 "        "凭证生成期间        "        旧凭证号
'000047225569309         40.00         2011年1月        771



多谢啦！

dj1971mahuateng

朱荣兴 发表于 2019-6-21 10:24
新建一个工作表，命名为   结果，然后运行代码
Sub 汇总() '''QQ:705664849
Dim d As Object

谢谢3楼楼主！非常感谢！
运行之后，可以得到合计金额不为零的数据，不过能不能麻烦您再帮我看一下，我想要完整的一条数据，就是保留下来的数据包含下列内容：
编码        " 金额        2 "        "凭证生成期间        "        旧凭证号
'000047225569309         40.00         2011年1月        771



多谢啦！

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("2011")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:d" & r)
   
9.   End With
   
10.   For i = 1 To UBound(arr)
    
11.     d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
    
12.   Next
    
13.   For Each aa In d.keys
    
14.     If d(aa) = 0 Then
    
15.       d.Remove (aa)
    
16.     End If
    
17.   Next
    
18.   ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
19.   m = 0
    
20.   For i = 1 To UBound(arr)
    
21.     If d.exists(arr(i, 1)) Then
    
22.       m = m + 1
    
23.       For j = 1 To UBound(arr, 2)
    
24.         brr(m, j) = arr(i, j)
    
25.       Next
    
26.     End If
    
27.   Next
    
28.   With Worksheets("结果")
    
29.     .UsedRange.Offset(1, 0).Clear
    
30.     .Range("a2").Resize(m, UBound(brr, 2)) = brr
    
31.   End With
    
32. End Sub
    

复制代码

chxw68

详见附件。

dj1971mahuateng

chxw68 发表于 2019-6-23 19:00
详见附件。

大神！多谢啦！很好用！

dj1971mahuateng

chxw68 发表于 2019-6-23 19:00
详见附件。

怎么做到的呢？真的很好用

chxw68

dj1971mahuateng 发表于 2019-6-23 19:08
怎么做到的呢？真的很好用

比较简单的问题，跟朱荣兴老师思路一样的，用字典来实现的。