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

fzxba

wowo000 发表于 2023-4-9 10:23
各位老师：假如K列是无序的如何写代码？（见附件）敬请帮助，谢谢！

条件求和后再计算差额00.rar (23.25 KB, 下载次数: 6)

2023-4-9 10:42 上传

点击文件名下载附件

wowo000

wowo000 发表于 2023-4-9 10:23
各位老师：假如K列是无序的如何写代码？（见附件）敬请帮助，谢谢！

哦，抱歉！忘了说明，即：敬请不要用代码依照K列排序，整个工作表保持原样。恳请帮忙，谢谢！！

wowo000

fzxba 发表于 2023-4-9 10:42

我和我的小伙伴惊呆了！衷心感谢您，尊敬的fzxba老师！！！太完美了！！！

准提部林

wowo000 发表于 2023-4-9 10:23
各位老师：假如K列是无序的如何写代码？（见附件）敬请帮助，谢谢！

加減//累計

Sub TEST_A2()
Dim Arr, xD, T$, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [j65536].End(3))
For i = 5 To UBound(Arr)
    T = Arr(i, 10)
    xD(T) = xD(T) + Val(Arr(i, 7)) - Val(Arr(i, 9))
    Arr(i - 4, 1) = xD(T)
Next i
[k5].Resize(UBound(Arr) - 4) = Arr
End Sub
  

准提部林

wowo000 发表于 2023-4-9 10:23
各位老师：假如K列是无序的如何写代码？（见附件）敬请帮助，谢谢！

如图//

chxw68

这样更简单。

wowo000

准提部林 发表于 2023-4-9 11:25
如图//

衷心感谢您的帮助，尊敬的准提部林老师！！！谢谢您！完美。

准提部林

需求(1)//合計+合併單元格
Sub TEST_A1()
Dim R&, xR As Range, xH As Range, S
With [k5:k6000]: .UnMerge: .ClearContents: End With
Application.ScreenUpdating = False
For Each xR In Range("j5:j" & [j65536].End(3).Row)
    If xR.Row < 5 Then Exit Sub
    If xR <> xR(0) Then Set xH = xR(1, 2): S = 0
    S = S + Val(xR(1, -2)) - Val(xR(1, 0))
    If xR <> xR(2) Then Range(xH, xR(1, 2)).Merge: xH = S
Next xR
End Sub

准提部林

//合計+合併單元格

wowo000

chxw68 发表于 2023-4-9 12:00
这样更简单。

谢谢您多次的帮助！衷心谢谢您！！！完美。