相同帐号的正负值抵消，如何提高VBA执行速度？

ghq200101

wdx223 发表于 2014-2-10 14:42
这样？只消除同一账号下金额互为正负的？

真是高人，真厉害！

ghq200101

grf1973 发表于 2014-2-10 14:36
请看附件。

谢谢，你这个更厉害！{:soso_e179:}

yjh_27

ghq200101 发表于 2014-2-10 11:55
非常感谢，运行快好多了，能否还有更快的办法吗？

请测试附件
多输出一行，请重新下载

grf1973

1. Sub 排序后对冲()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     r = [a65536].End(3).Row
   
4.     Range("a1:b" & r).Copy [f1]
   
5.     Range("f2:g" & r).Sort key1:=[f2]
   
6.     arr = Range("f1:g" & r)
   
7.     For i = 2 To UBound(arr)
   
8.         x = "'" & arr(i, 1)
   
9.        d(x) = d(x) & "+" & i
   
10.     Next
    
11.     dk = d.keys: dt = d.items
    
12.     For i = 0 To UBound(dk)
    
13.         x = Split(dt(i), "+")
    
14.         s1 = Val(x(1)): s2 = Val(x(UBound(x)))
    
15.         For j = s1 To s2 - 1
    
16.             For k = j + 1 To s2
    
17.                 If arr(j, 2) + arr(k, 2) = 0 Then
    
18.                     arr(k, 2) = 0: arr(j, 2) = 0
    
19.                     Exit For
    
20.                 End If
    
21.             Next
    
22.         Next
    
23.     Next
    
24.     ReDim brr(1 To UBound(arr), 1 To 2)
    
25.     brr(1, 1) = arr(1, 1): brr(1, 2) = arr(1, 2)
    
26.     p = 1
    
27.     For i = 2 To UBound(arr)
    
28.         If arr(i, 2) <> 0 Then
    
29.             p = p + 1
    
30.             brr(p, 1) = arr(i, 1)
    
31.             brr(p, 2) = arr(i, 2)
    
32.         End If
    
33.     Next
    
34.     Range("f:g").ClearContents
    
35.     [f1].Resize(p, 2) = brr
    
36.    
    
37. End Sub
    

复制代码

ghq200101

grf1973 发表于 2014-2-10 16:02

如果，我增加序号和操作日期列，如果再根据相同帐号进行金额正负抵消呢，请赐教，谢谢！{:soso_e181:}

ghq200101

yjh_27 发表于 2014-2-10 14:55
请测试附件

请教，你附表中的VBA代码，用在我附表里（增加了序号和操作日期），相同帐号的正负金额抵消，如何写代码啊？

yjh_27

ghq200101 发表于 2014-2-10 17:10
请教，你附表中的VBA代码，用在我附表里（增加了序号和操作日期），相同帐号的正负金额抵消，如何写代码啊 ...

参见附件。

ghq200101

yjh_27 发表于 2014-2-10 18:51
参见附件。

不好意思，你附表中正负抵消后，金额合计与原先不一致，谢谢！

yjh_27

ghq200101 发表于 2014-2-10 20:57
不好意思，你附表中正负抵消后，金额合计与原先不一致，谢谢！

改漏了一处。重新下载27L附件

ghq200101

yjh_27 发表于 2014-2-10 22:11
改漏了一处。重新下载27L附件

非常感谢，基本上能达到我的要求了，不过就是代码太多，速度没有24楼的快，谢谢！