VBA 代码：减去值直到它达到零

Question

我一直在尝试在 VBA 中运行具有以下逻辑方案的代码：

• 如果“MVT Inventory”（由 C 列表示）<“Tot Inventory”（由 D 列表示），则在位于“Tot Inventory”的单元格上显示差异（“Tot Inventory”-“MVT Inventory”）列本身；
• 如果（“MVT Inventory”>“Tot Inventory”），则在 B 列中找到下一个具有相同字母的“Tot Inventory”，并减去“MVT Inventory”-“Tot Inventory”的差值，直到该差值达到零.

例子：

A - “MVT 库存” = 500 和“总库存” = 1200，然后“总库存” = 1200 - 500 = 700

另一个 A - “MVT Inventory” = 1500 和“Tot Inventory” = 400，“Tot Inventory” = - 1100。
-1100 的差值需要在 Name 列找到另一行有 A 并用另一个“Tot Inventory”减去，直到差值达到零。 除此之外，MVT 列的所有单元都需要在程序结束时达到零。

这是我正在处理的工作表：

这是我完成的代码。 在第一个If条件下的Else命令之后我遇到了问题。 在此之前，代码运行良好。

Dim i, j, k As Integer
Dim dif

last_main_row = Sheets("Inventories").Range("B" & Rows.count).End(xlUp).Row
last_name_row = Sheets("Inventories").Range("H" & Rows.count).End(xlUp).Row

For j = 5 To last_name_row
    While Cells(j, "I") <> 0
        For i = 4 To last_main_row
            dif = Cells(i, "D") - Cells(i, "C")
            If dif >= 0 Then
                Cells(i, "D") = dif
                Cells(i, "C") = 0
            Else
                While dif < 0
                    For k = 4 To last_main_row
                        If Cells(j, "B") = Cells(k, "B") Then
                            Cells(k, "D") = Cells(k, "D") + dif
                            dif = dif + Cells(k, "D")
                        End If
                    Next
                Wend
            End If
        Next
    Wend
Next

Answer 1

' Try this instead
Sub testnja()

    Dim NameRow As Range
    Dim NameInvRow As Range
    Dim NameInvRowFind As Range
    
    For Each NameRow In ActiveSheet.UsedRange.Columns(8).Cells
        
        NameRow.Select
        
        If NameRow.Row > 1 Then
            If Trim(NameRow) <> "" Then
            
                For Each NameInvRow In ActiveSheet.UsedRange.Columns(2).Cells
                    If NameInvRow = NameRow Then
                                   
                        If NameInvRow.Offset(0, 2) >= NameInvRow.Offset(0, 1) Then
                            NameInvRow.Offset(0, 2) = NameInvRow.Offset(0, 2) - NameInvRow.Offset(0, 1)
                            NameInvRow.Offset(0, 1) = 0
                        Else
                            
                            For Each NameInvRowFind In ActiveSheet.UsedRange.Columns(2).Cells
                                If NameInvRowFind = NameRow And _
                                    NameInvRowFind.Row <> NameInvRow.Row Then
                                    
                                    If NameInvRowFind.Offset(0, 2) >= NameInvRow.Offset(0, 1) Then
                                        NameInvRowFind.Offset(0, 2) = NameInvRowFind.Offset(0, 2) - NameInvRow.Offset(0, 1)
                                        NameInvRow.Offset(0, 1) = 0
                                        Exit For
                                    End If
                                        
                                End If
                            Next
                        
                        End If
                    
                    End If
                Next
            
            Else
                Exit Sub
            End If
        End If
    
    Next
    
End Sub

Answer 2

如果将 diff 添加到 MVT 列而不是从 Tot 中减去，则如果 Tot 小于差异，则可以避免递归。

Option Explicit

Sub a()

    Dim i As Long, j As Long, k As Long
    Dim dif As Long, sName As String
    Dim last_main_row As Long, last_name_row As Long

    With Sheets("Inventories")
        last_main_row = .Range("B" & Rows.Count).End(xlUp).Row
        last_name_row = .Range("H" & Rows.Count).End(xlUp).Row
    End With

    For i = 2 To last_main_row
        dif = Cells(i, "D") - Cells(i, "C")
        sName = Cells(i, "B")
        If dif >= 0 Then
            Cells(i, "C") = 0
            Cells(i, "D") = dif
        Else
           ' add diff onto next occurance of name
           For k = i + 1 To last_main_row
               If Cells(k, "B") = sName Then
                   Cells(k, "C") = Cells(k, "C") - dif
                   Cells(i, "C") = 0
                   Cells(i, "D") = 0
                   dif = 0
                   Exit For
               End If
            Next
            If dif <> 0 Then
                MsgBox "No record " & sName & " for diff of " & dif, vbExclamation
            End If
        End If
    Next
 
End Sub