金额计算

zllyyz

来位大神，解决数据计算问题，谢谢。需求如下图:

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.2.19
   
2.     On Error Resume Next
   
3.     With Sheets("Sheet1")
   
4.         arr = .[c6:p14]
   
5.         For i = 1 To UBound(arr) Step 3
   
6.             sum1 = 0: sum2 = 0
   
7.             For j = 3 To UBound(arr, 2)
   
8.                 sum1 = sum1 + arr(i, j)
   
9.                 sum2 = sum2 + arr(i + 1, j)
   
10.                 arr(i + 2, j) = arr(i, j) - arr(i + 1, j)
    
11.             Next
    
12.             arr(i, 2) = sum1
    
13.             arr(i + 1, 2) = sum2
    
14.             arr(i + 2, 2) = sum1 - sum2
    
15.         Next
    
16.         .[c6:p14] = arr
    
17.     End With
    
18. End Sub
    
19. 
    

复制代码

zllyyz

ykcbf1100 发表于 2024-2-19 22:38
附件供参考。。。

老师 请对比下结果，在发挥下

半百

请测试

zllyyz

半百 发表于 2024-2-20 12:56
请测试

好活,膜拜+++++++++++++太厉害了

zllyyz

半百 发表于 2024-2-20 12:56
请测试

数据量一大 后面就出错了,可能得再加循环或者条件？？？

gwjkkkkk

根据摸拟结果，有些看不懂数据的逻辑。。。

半百

zllyyz 发表于 2024-2-20 19:32
数据量一大 后面就出错了,可能得再加循环或者条件？？？

啥意思？红色单元格的数字怎么来的？

准提部林

Sub Test_A1() '\\by.准提部林
Dim xA As Range, i&, j%, P
Set xA = Range(Cells(Rows.Count, "d").End(3)(1, 2), Cells(5, Columns.Count).End(1)(2))
For i = 1 To xA.Rows.Count Step 3
    xA.Rows(i + 2).ClearContents
    For j = xA.Columns.Count To 1 Step -1
        P = P + xA(i, j) - xA(i + 1, j)
        If P > 0 Then xA(i + 2, j) = P: P = 0
    Next j
    If P <> 0 Then xA(i + 2, 1) = P: P = 0
Next i
End Sub