[已解决]应收账款余额计算函数搞不定，能不能用自定义函数或VBA

grf1973

太折腾了，想不明白了。。。。。。。。。。。

西贝木一

grf1973 发表于 2015-12-4 10:33
太折腾了，想不明白了。。。。。。。。。。。

不好意思，非常感谢您！

grf1973

代码是编了一个，但找不出错在哪里。

1. Sub 计算New()       '目的：让每一期的 “期初+销售-回款”尽量向0值靠近
   
2.     arr = Range("a4:z" & [a65536].End(3).Row)
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     x = 0
   
5.     For i = 1 To UBound(arr)
   
6.         bm = arr(i, 2)    '以编码为key
   
7.         d(arr(i, 2)) = d(arr(i, 2)) & "," & i
   
8.     Next
   
9.     For Each bm In d.keys
   
10.         hsrr = Split(d(bm), ","): r = UBound(hsrr)
    
11.         If r > 1 Then
    
12.             For i = 2 To r
    
13.                 k1 = Val(hsrr(i))
    
14.                 a1 = arr(k1, 5 + x): b1 = arr(k1, 6 + x): c1 = arr(k1, 7 + x)
    
15.                 If a1 < 0 Then        '期初小于0
    
16.                     For j = i - 1 To 1 Step -1 '从下往上冲抵
    
17.                         k = Val(hsrr(j))
    
18.                         a = arr(k, 5 + x): b = arr(k, 6 + x): c = arr(k, 7 + x)
    
19.                         If a + b - c <> 0 Then
    
20.                             If (a + b - c) + a1 > 0 Then
    
21.                                 a = a + a1: a1 = 0
    
22.                             Else
    
23.                                 a1 = a1 + (a + b - c): a = c - b
    
24.                             End If
    
25.                             arr(k, 5 + x) = a: arr(k, 6 + x) = b: arr(k, 7 + x) = c
    
26.                             arr(k1, 5 + x) = a1: arr(k1, 6 + x) = b1: arr(k1, 7 + x) = c1
    
27.                         End If
    
28.                     Next
    
29.                 End If
    
30.                         
    
31.                 If b1 < 0 Then        '销售小于0
    
32.                     For j = i - 1 To 1 Step -1 '从下往上冲抵
    
33.                         k = Val(hsrr(j))
    
34.                         a = arr(k, 5 + x): b = arr(k, 6 + x): c = arr(k, 7 + x)
    
35.                         If a + b - c > 0 Then
    
36.                             If (a + b - c) + b1 > 0 Then
    
37.                                 a = a + b1: a1 = 0
    
38.                             Else
    
39.                                 b1 = b1 + (a + b - c): a = c - b
    
40.                             End If
    
41.                             arr(k, 5 + x) = a: arr(k, 6 + x) = b: arr(k, 7 + x) = c
    
42.                             arr(k1, 5 + x) = a1: arr(k1, 6 + x) = b1: arr(k1, 7 + x) = c1
    
43.                         End If
    
44.                     Next
    
45.                 End If
    
46.                     
    
47.                 If c1 < 0 Then        '回款小于0，只与回款冲抵
    
48.                     For j = i - 1 To 1 Step -1 '从下往上冲抵
    
49.                         k = Val(hsrr(j))
    
50.                         a = arr(k, 5 + x): b = arr(k, 6 + x): c = arr(k, 7 + x)
    
51.                         If c > 0 Then c = c + c1: c1 = 0
    
52.                         arr(k, 7 + x) = c
    
53.                         arr(k1, 7 + x) = c1
    
54.                     Next
    
55.                 End If
    
56.                
    
57.                 If c1 > 0 Then        '回款大于0
    
58.                     For j = 1 To i - 1 '从上往下冲抵
    
59.                         k = Val(hsrr(j))
    
60.                         a = arr(k, 5 + x): b = arr(k, 6 + x): c = arr(k, 7 + x)
    
61.                         If a + b - c <> 0 Then
    
62.                             If (a + b - c) - c1 > 0 Then
    
63.                                 a = a - c1: c1 = 0
    
64.                             Else
    
65.                                 c1 = c1 - (a + b - c): a = c - b
    
66.                             End If
    
67.                             arr(k, 5 + x) = a: arr(k, 6 + x) = b: arr(k, 7 + x) = c
    
68.                             arr(k1, 5 + x) = a1: arr(k1, 6 + x) = b1: arr(k1, 7 + x) = c1
    
69.                         End If
    
70.                     Next
    
71.                 End If
    
72.             Next
    
73.         End If
    
74.         For i = 1 To r
    
75.             k = Val(hsrr(i))
    
76.             arr(k, 8 + x) = arr(k, 5 + x) + arr(k, 6 + x) - arr(k, 7 + x)
    
77.         Next
    
78.     Next
    
79.     Range("h4:h" & [a65536].End(3).Row) = Application.Index(arr, , 8 + x)
    
80. 
    
81. End Sub

复制代码

西贝木一

grf1973 发表于 2015-12-4 11:00
代码是编了一个，但找不出错在哪里。

grf1973老师，非常非常感谢！
计算结果不正确。还是很感谢！