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

Posted 2023-02-19

【中文标题】VBA代码：减去值直到它达到零

【英文标题】：VBA Code: Substract value until it reaches ZERO

【发布时间】：2021-06-20 12:02:26

【问题描述】：

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

如果“MVT Inventory”（由 C 列表示） 如果 ("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

【问题讨论】：

为什么你不能把所有的Tot Inventory 和Name 相加，得到每个名字的真实总数？然后从那开始工作？

注意：库存系统的更好工具是 MSAccess。有大量的模板和示例可以解决您的大部分问题。

【参考方案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

【参考方案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