拆分金额问题

这个核销会有几种情况，只用函数不太好处理，用VBA会更方便一些。
简单写了个程序，见下图
增加了剩余款项列：用于记录还未全部收到的款项
在对账时可选择：继续对账(继续原有数据对账)和重新对账(删除旧数据，重新对账)
只是简单实现了需求，对于分几次付款的记录会显示多行日期
如果要做得更好用，可以细化一些提示、统计等

下面为VBA程序代码

Option Explicit
Sub abc()
　Dim a(1), i, j, p, n, d
　a(0) = Range("k3:n" & [k2].End(xlDown).Row).Value
　Set d = CreateObject("scripting.dictionary")
　For i = 1 To UBound(a(0))
　　If Not d.exists(a(0)(i, 1)) Then d(a(0)(i, 1)) = i Else MsgBox "!": Exit Sub
　Next
　a(1) = [a1].CurrentRegion.Offset(1).Resize(, 6).Value
　ReDim b(1 To UBound(a(1)) - 1, 1 To 2)
　For i = 1 To UBound(a(1)) - 1
　　If a(1)(i, 1) <> a(1)(i + 1, 1) Then
　　　If d.exists(a(1)(i, 1)) Then
　　　　n = a(0)(d(a(1)(i, 1)), 4)
　　　　For j = p + 1 To i
　　　　　b(j, 2) = a(0)(d(a(1)(i, 1)), 3)
　　　　　If n > a(1)(j, 6) Then
　　　　　　b(j, 1) = a(1)(j, 6): n = n - b(j, 1)
　　　　　Else
　　　　　　b(j, 1) = n: Exit For
　　　　　End If
　　　　Next
　　　End If
　　　p = i
　　End If
　Next
　[g2].Resize(UBound(b), 2) = b
End Sub