条件分别求和后再计算其差额

wowo000

各位老师：礼拜天快乐！敬请帮俺实现附件里的要求，多谢！！！

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr, zrr()
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     With Worksheets("账单")
   
7.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
8.         .Range("k5:k" & r).UnMerge
   
9.         arr = .Range("a1:k" & r)
   
10.         xm = Empty
    
11.         m = 0
    
12.         For i = 5 To UBound(arr)
    
13.             If arr(i, 10) <> xm Then
    
14.                 m = m + 1
    
15.                 ReDim Preserve zrr(1 To m)
    
16.                 zrr(m) = Array(i, i)
    
17.                 xm = arr(i, 10)
    
18.             Else
    
19.                 If m > 0 Then
    
20.                     zrr(m)(1) = i
    
21.                 End If
    
22.             End If
    
23.         Next
    
24.         For i = 1 To UBound(zrr)
    
25.             s = 0
    
26.             For j = zrr(i)(0) To zrr(i)(1)
    
27.                 s = s + arr(j, 9) - arr(j, 7)
    
28.             Next
    
29.             With .Range(.Cells(zrr(i)(0), 11), .Cells(zrr(i)(1), 11))
    
30.                 .Merge
    
31.                 .Value = s
    
32.             End With
    
33.         Next
    
34.     End With
    
35. End Sub
    

复制代码

chxw68

详见附件。

剑指E

fzxba

条件求和后再计算差额0.rar (25.92 KB, 下载次数: 5)

2023-4-9 09:34 上传

点击文件名下载附件

wowo000

chxw68 发表于 2023-4-9 09:19
详见附件。

衷心感谢您，尊敬的chxw68老师！谢谢！！！完美。

wowo000

剑指E 发表于 2023-4-9 09:25

衷心谢谢您，尊敬的剑指E老师！！！完美。

wowo000

fzxba 发表于 2023-4-9 09:34

衷心感谢您，尊敬的fzxba老师！谢谢您的帮助！！谢谢！！！完美。

蓝桥玄霜

差价的例子：

wowo000

各位老师：假如K列是无序的如何写代码？（见附件）敬请帮助，谢谢！