应收款自动拆分核销并对应

poormemory

需要将左边的表格做成右边的效果，就是当收款小于应收，就将应收拆解成收款对等金额，余下应收未收对应下一笔收款和对应的收款日期，如果收款大于应收，则将收款拆解成应收对等金额，余下的收款对应下一笔应收。请问有什么解决办法呢？谢谢各位大神指教！

3190496160

你的说明，跟你模拟的结果不相符嘛，比如：出货日期7月14日的这一行数据，明显，收款大于应收款了，但是，你模拟的数据并没有体现你所说的拆分呀，具体需要如何拆分？请认真模拟结果，

poormemory

3190496160 发表于 2020-8-20 12:18
你的说明，跟你模拟的结果不相符嘛，比如：出货日期7月14日的这一行数据，明显，收款大于应收款了，但是， ...

7月14的收款是先核销7月11日的回款余额21144.62，再继续核销7月14的货款6202.6，再核销6月25……

3190496160

Sub zhengli()
Dim ar As Variant
Dim br()
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:g" & r)
    ReDim br(1 To UBound(ar) * 10, 1 To UBound(ar, 2))
    For i = 2 To UBound(ar)
        If Trim(ar(i, 5)) <> "" And Trim(ar(i, 7)) <> "" Then
            If ar(i, 5) > ar(i, 7) Then
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    br(n, j) = ar(i, j)
                Next j
                br(n, 5) = br(n, 7)
                sl = ar(i, 5) - ar(i, 7)
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    br(n, j) = ar(i, j)
                Next j
                br(n, 5) = sl
                br(n, 7) = sl
            ElseIf ar(i, 5) < ar(i, 7) Then
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    br(n, j) = ar(i, j)
                Next j
                br(n, 7) = br(n, 5)
                sl = ar(i, 7) - ar(i, 5)
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    br(n, j) = ar(i, j)
                Next j
                br(n, 5) = sl
                br(n, 7) = sl
            End If
        ElseIf Trim(ar(i, 5)) <> "" And Trim(ar(i, 7)) = "" Then
            n = n + 1
            For j = 1 To UBound(ar, 2)
                br(n, j) = ar(i, j)
           Next j
           br(n, 7) = br(n, 5)
        ElseIf Trim(ar(i, 5)) = "" And Trim(ar(i, 7)) <> "" Then
            n = n + 1
            For j = 1 To UBound(ar, 2)
                br(n, j) = ar(i, j)
           Next j
           br(n, 5) = br(n, 7)
        End If
    Next i
    rs = .Cells(Rows.Count, 9).End(xlUp).Row + 1
    .Range("i2:o" & rs) = Empty
    .[i2].Resize(n, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub

3190496160

代码是猜着做的，仅供参考，