帮忙把代码增加点功能

dbg111222

我想在下面的代码中增加按照从A列的A5开始按照时间排序，排序完后增加If r > 5 Then br(r, 8) = br(r - 1, 8) +  br(r, 4) - br(r, 5) - br(r, 6) + br(r, 7)，最下面一行B列和J列的地方增加固定签字的地方，谢谢！


Sub 明细帐页()

ar = Sheets("库存").UsedRange
With Sheets("明细账页")
    m = .Range("b2")
    bm = .Range("e2")
    .[h2] = ""
    .[b3] = ""
    .[e3] = ""
    .UsedRange.Offset(4).Clear
    br = .Range("a1").Resize(9999, 11)
    r = 4
End With
   
    For i = 3 To UBound(ar)
        If ar(i, 2) = bm Then
            br(2, 9) = ar(i, 19)
            br(3, 2) = ar(i, 5)
            br(3, 5) = ar(i, 4)
            r = r + 1
            br(r, 1) = DateSerial(Year(Now), m, 1)
            br(r, 3) = ar(i, 6)
            br(r, 8) = ar(i, 6)
            Exit For
        End If
    Next
   

sr = Sheets("收入").UsedRange
    For i = 2 To UBound(sr)
        If sr(i, 2) = bm And month(sr(i, 12)) = m Then
            r = r + 1
            br(r, 1) = sr(i, 12)
'            br(r, 2) = sr(i, 11)
            br(r, 4) = sr(i, 6)
            If r > 5 Then br(r, 8) = br(r - 1, 8) + sr(i, 6)
            br(r, 9) = sr(i, 13)
        End If
    Next
   
fc = Sheets("发出").UsedRange
    For i = 2 To UBound(fc)
        If fc(i, 2) = bm And month(fc(i, 11)) = m Then
            r = r + 1
            br(r, 1) = fc(i, 11)
            br(r, 2) = fc(i, 9) & fc(i, 10)
            br(r, 5) = fc(i, 6)
            br(r, 8) = br(r - 1, 8) - fc(i, 6)
            br(r, 10) = fc(i, 12)
        End If
    Next
   
tl = Sheets("退料").UsedRange
    For i = 2 To UBound(tl)
        If tl(i, 2) = bm And month(tl(i, 11)) = m Then
            r = r + 1
            br(r, 1) = tl(i, 11)
'            br(R, 2) = tl(i, 9)
            br(r, 6) = tl(i, 6)
            br(r, 8) = br(r - 1, 8) - tl(i, 6)
        End If
    Next
   
tk = Sheets("退库").UsedRange
    For i = 2 To UBound(tl)
        If tk(i, 2) = bm And month(tk(i, 12)) = m Then
            r = r + 1
            br(r, 1) = tk(i, 12)
            br(r, 2) = tk(i, 10) & tk(i, 11)
            br(r, 7) = tk(i, 6)
            br(r, 8) = br(r - 1, 8) + tk(i, 6)
        End If
    Next
   
   
With Sheets("明细账页").Range("a1").Resize(r, 11)
    .Value = br
    .Borders.LineStyle = xlContinuous
End With
   
   
End Sub

liulang0808

建议楼主上传模拟附件，便于大家处理

dbg111222

就是计算完成后对brr从第6行开始排序

dbg111222

排序后再增加我说的计算

ykcbf1100

没有附件，写代码时不好调试的。

于箱长

ykcbf1100 发表于 2024-2-29 14:00
没有附件，写代码时不好调试的。

他的附件在我说有坑的那个帖子里

ykcbf1100

于箱长 发表于 2024-2-29 14:05
他的附件在我说有坑的那个帖子里

这样啊，还是你记性好。

dbg111222

于箱长 发表于 2024-2-29 14:05
他的附件在我说有坑的那个帖子里

你总是说有坑，其实没有，我只是要增加点别的功能，你说的问题我这里都解决了。

于箱长

dbg111222 发表于 2024-2-29 14:09
你总是说有坑，其实没有，我只是要增加点别的功能，你说的问题我这里都解决了。

有没有不重要，事实上你确实没有快速的获得自己想要的结果，因为各位老师不一定都是财务专业的，不一定都能充分理解诉求，我说有坑的意思也是说只要有考虑不到的地方或者原始资料不完整的话，是不容易满足求助需求，仅此而已，楼主要是不高兴的话，略过就好，你就还按自己的思路求助吧