Vba или формула для распределения суммы на основе дат

Question

возможно ли выделить (разделить) сумму по датам? Например, у меня такая ситуация:

ID           Date    Invoice value  ColumnD
ID0001    01/01/2020    200         here I need to insert the value
ID0001    01/02/2020    300         here I need to insert the value
ID0001    01/03/2020    500         here I need to insert the value
ID0002    01/03/2020    1000        here I need to insert the value
ID0002    01/04/2020    1500        here I need to insert the value

Я знаю, что значение, которое нужно выделить, для ID0001 - 600, а для ID0002 - 2000. Теперь мне нужно выделить первые 100 на основе дат на ID0001. Итак, я мог бы:

ID           Date    Invoice value  ColumnD
ID0001    01/01/2020    200         0
ID0001    01/02/2020    300         0
ID0001    01/03/2020    500         400
ID0002    01/03/2020    1000        here I need to insert the value
ID0002    01/04/2020    1500        here I need to insert the value

И второе значение (200) распределить таким образом:

ID           Date    Invoice value  ColumnD
ID0001    01/01/2020    200         0
ID0001    01/02/2020    300         0
ID0001    01/03/2020    500         400
ID0002    01/03/2020    1000        0
ID0002    01/04/2020    1500        500

Можно ли сделать это с помощью формулы или VBA?

Answer 1

Пусть «Выделенное значение» помещено в столбец D

Затем в E2 формула скопирована:

=MAX(0,SUMIF(A$2:A2,A2,C$2:C2)-SUMIF(A:A,A2,D:D))

введите описание изображения здесь

Answer 2

Вот вам VBA для начала. Он выполняет некоторые проверки ошибок, но не все. Самая большая дыра в том, что делать, если платеж превышает общую сумму неоплаченных счетов. Примечание. Я создал имя диапазона для тестирования «InvoiceIDs», вы захотите сделать его именем диапазона dynamic c, чтобы вам не приходилось беспокоиться об этом в будущем. Макрос также предполагает, что номера счетов всегда будут в отсортированном порядке!

Option Explicit

Sub PostInvoice()

   Dim zId  As Variant
   Dim dPmt As Variant
   Dim lRow As Long
   Dim rng  As Range
   
   lRow = 0
   
   Do While lRow = 0
   
     zId = InputBox("Enter Account ID", "Account Selection:")
     If (zId = "") Then Exit Sub
    
     On Error Resume Next
       lRow = Application.WorksheetFunction.Match(zId, Range("InvoiceIDs"), 0)
       Set rng = Cells(lRow, 4)
     On Error GoTo 0
   
     If (lRow = 0) Then
       MsgBox "Invoice ID: " & zId & " Not Found!", vbOKOnly + vbCritical
     End If
  
   Loop
   
   dPmt = InputBox("Enter Payment Amount", "Record a Payment:")
   If (dPmt = "") Then Exit Sub
   
     
   Do While dPmt > 0
     
     If (rng.Value > 0) Then
     
       If (dPmt >= rng.Value) Then
         dPmt = dPmt - rng.Value
         rng.Value = 0
       Else
         rng.Value = rng.Value - dPmt
         dPmt = 0
       End If
        
     End If
     
     Set rng = rng.Offset(1, 0)
     
     If (rng.Offset(0, -3).Value <> zId) Then Exit Do
   
   Loop

End Sub 'PostInvoice

Другими вещами, которые следует учитывать, было бы превращение InputBoxes в UserForm для более плавного интерфейса.

Перед запуском:

After Run:

введите описание изображения здесь HTH