Excel VBA多工作表汇总低库存数据漏项问题排查修复

问题背景 #

• 业务场景：使用VBA核查按区域拆分在6个独立工作表的自制库存文档，每个零件占1行数据，字段包含零件编号、描述、其他属性信息、最低库存值、当前库存总量、最高库存值。
• 原有规则：若当前库存总量小于等于最低库存值，在最高库存列右侧的O列标记Low；逐行遍历各工作表，将O列值为Low的行同步到专门的低库存汇总工作表，同时通过子过程记录代码运行时间，方便采购人员获知最后核查时间。
• 异常现象：单工作表运行正常，多工作表场景下出现数据遗漏。例如2个工作表各有5条低库存记录（合计10条），运行后仅汇总9条，第一个工作表仅同步4条、第二个工作表同步5条，缺失1条数据。

原有问题代码 #

Sub Clear()

Worksheets("Sheet2").Range("Low_Inventory").ClearContents

Call MoveData1
Call MoveData2

End Sub


Sub MoveData1()


endrow = Sheet1.Cells(3, 2).CurrentRegion.Rows.Count
endcolumn = Sheet1.Cells(3, 2).CurrentRegion.Columns.Count
repeatrow = Sheet3.Cells(3, 2).CurrentRegion.Rows.Count + 1

For xrow = endrow To 2 Step by - 1
    If Sheet1.Cells(xrow, 15) = "Low" Then
        For xcolumn = 1 To endcolumn
          Sheet3.Cells(repeatrow, xcolumn) = Sheet1.Cells(xrow, xcolumn)
        Next
        repeatrow = repeatrow + 1
        
    End If
 If Sheet1.Cells(xrow, 15) = "Low" Then
        Call xdate1
    End If
Next



End Sub


Sub xdate1()

Dim xdate
xdate = Now
endrow = Sheet1.Cells(3, 2).CurrentRegion.Rows.Count
endcolumn = Sheet1.Cells(3, 2).CurrentRegion.Columns.Count
repeatrow = Sheet3.Cells(3, 2).CurrentRegion.Rows.Count + 1

For xrow = endrow To 2 Step by - 1
    If Sheet1.Cells(xrow, 15) = "Low" Then
        For xcolumn = 1 To endcolumn
         Sheet3.Cells(repeatrow, 16) = xdate
        Next
        repeatrow = repeatrow
        
    End If
Next


End Sub


Sub MoveData2()


endrow = Sheet2.Cells(3, 2).CurrentRegion.Rows.Count
endcolumn = Sheet2.Cells(3, 2).CurrentRegion.Columns.Count
repeatrow = Sheet3.Cells(3, 2).CurrentRegion.Rows.Count + 1

For xrow = endrow To 2 Step by - 1
    If Sheet2.Cells(xrow, 15) = "Low" Then
        For xcolumn = 1 To endcolumn
          Sheet3.Cells(repeatrow, xcolumn) = Sheet2.Cells(xrow, xcolumn)
        Next
        repeatrow = repeatrow + 1
        
    End If
 If Sheet2.Cells(xrow, 15) = "Low" Then
        Call xdate2
    End If
Next



End Sub


Sub xdate2()

Dim xdate
xdate = Now
endrow = Sheet2.Cells(3, 2).CurrentRegion.Rows.Count
endcolumn = Sheet2.Cells(3, 2).CurrentRegion.Columns.Count
repeatrow = Sheet3.Cells(3, 2).CurrentRegion.Rows.Count + 1

For xrow = endrow To 2 Step by - 1
    If Sheet2.Cells(xrow, 15) = "Low" Then
        For xcolumn = 1 To endcolumn
         Sheet3.Cells(repeatrow, 16) = xdate
        Next
        repeatrow = repeatrow
        
    End If
Next


End Sub

核心错误点 #

• 汇总表清空对象错误：实际存储低库存汇总数据的是Sheet3，但Clear过程中写的是清空Sheet2的Low_Inventory区域，每次运行前旧的汇总数据没有被清除，后续计算汇总表空行位置时会把残留旧数据算入，直接导致写入位置错位。
• 时间写入逻辑冗余且会覆盖有效数据：每识别到1条带Low标记的行就调用一次xdate子过程，该子过程会重新遍历整个源工作表的所有低库存行，反复往汇总表固定起始行写时间，属于重复无效计算，还会直接覆盖已经写入的零件数据，是漏数的核心诱因。
• 行号计数不同步：MoveData过程和xdate过程各自独立计算汇总表写入行号，两个过程的行号变量不互通，xdate写入数据时用的行号不会跟随MoveData的写入进度递增，极易出现同位置反复写入、覆盖有效数据的问题。
• 冗余遍历增加出错概率：写入核查时间不需要单独做全表循环，同步完单条零件数据后直接在当前行的时间列写值即可，多一层全表遍历只会提升逻辑出错的可能。

修复后代码 #

' 强制所有变量提前声明，避免隐式变量导致的逻辑错误
Option Explicit

Sub Clear()
    ' 正确清空汇总表（Sheet3）的历史汇总数据，可根据实际表名调整
    Sheet3.Range("Low_Inventory").ClearContents
    ' 调用通用过程处理对应工作表，不需要为每个工作表单独写重复逻辑
    Call MoveLowInventoryData(Sheet1, Sheet3)
    Call MoveLowInventoryData(Sheet2, Sheet3)
    ' 后续需要处理剩余4个工作表时，直接按格式新增Call语句即可
    ' 示例：Call MoveLowInventoryData(Sheet4, Sheet3)
End Sub

Sub MoveLowInventoryData(sourceSht As Worksheet, summarySht As Worksheet)
    Dim endRow As Long, endCol As Long, xRow As Long, xCol As Long
    Dim targetRow As Long, checkTime As Date
    ' 统一记录本次核查时间，本次同步的所有记录共用该时间值
    checkTime = Now()
    
    ' 计算源表数据边界、汇总表下一个可写入的空行位置
    endRow = sourceSht.Cells(3, 2).CurrentRegion.Rows.Count
    endCol = sourceSht.Cells(3, 2).CurrentRegion.Columns.Count
    targetRow = summarySht.Cells(3, 2).CurrentRegion.Rows.Count + 1
    
    ' 逐行遍历源表数据
    For xRow = endRow To 2 Step -1
        If sourceSht.Cells(xRow, 15) = "Low" Then
            ' 同步整行零件基础信息
            For xCol = 1 To endCol
                summarySht.Cells(targetRow, xCol) = sourceSht.Cells(xRow, xCol)
            Next
            ' 直接在当前同步行的P列（第16列）写入核查时间，无需额外循环
            summarySht.Cells(targetRow, 16) = checkTime
            ' 写入行号递增，准备写入下一条记录
            targetRow = targetRow + 1
        End If
    Next
End Sub

修复说明 #

• 修正了汇总表清空的目标对象，每次运行先清除历史汇总数据，避免旧数据干扰空行位置计算
• 将原来重复的MoveData1/2、xdate1/2合并为支持传参的通用过程，后续新增待处理工作表时不需要重复编写冗余逻辑，从结构上减少代码出错概率
• 删除了冗余的二次遍历写时间逻辑，同步单条数据时直接在对应行写入时间，彻底解决多过程行号不同步、数据覆盖的问题
• 增加强制变量声明，避免未定义变量导致的隐式逻辑错误
• 统一写入行号的计数逻辑，所有写入操作共用同一个行号变量，完全避免写入位置错位问题

内容的提问来源于stack exchange，提问作者Tkucera