Excel VBA宏实现两工作表产品数量匹配 导出不匹配记录

需求说明 #

需开发VBA宏完成结构一致的两个工作表数据比对，两表均包含三类字段：Product（产品）、Serial（序列号）、Qty（数量），具体规则如下：

• Sheet1为主记录表（master record），作为比对基准；Sheet2为查询记录表（qry record），为待比对数据源
• 以「产品编号+序列号」作为唯一匹配键，遍历Sheet1全量记录，查找Sheet2中同产品、同序列号的对应条目，对比两者的Qty（数量）字段值
• 不匹配判定规则：匹配到的条目Qty值与Sheet1不一致即判定为异常（例：Sheet1中产品"P56017-A"对应数量为50，Sheet2中同产品同序列号记录数量为40，即属于数量不匹配项）；所有不匹配条目的产品编号、两表对应数量值需统一写入Sheet3，替代人工逐行核对，降低重复工作量。

现有代码问题 #

当前已完成的代码仅实现了匹配键查找、Sheet2字段值回写Sheet1的基础逻辑，缺少数量差异判定、不匹配记录导出Sheet3的核心能力，且存在变量未定义、函数拼写错误问题，原有代码如下：

Sub Mismatch()

    Set ws1 = sheetS("S1")
    Set ws2 = sheetS("S2")

    ws1UniqueIDCol = "A"
    ws1LineIdCol = "C"
    ws1ValToWriteCol = "D"
    ws1StartRow = 1
    ws1EndRow = ws1.UsedRange.Rows(ws1.UsedRange.Rows.Count).row
    
    
    ws2UniqueIDCol = "A"
    ws2LineIdCol = "C"
    ws2ValToCopyCol = "D"
    ws2EndRow = ws2.UsedRange.Rows(ws2.UsedRange.Rows.Count).row
    
    For i = ws1StartRow To ws1EndRow        '
        searchKey = ws1.Range(ws1UniqueIDCol & i) & ws1.Range(ws1LineIdCol & i)
        If (searchKey <> "") Then
            For j = ws2StartRow To ws2EndRow
                 foundKey = ws2.Range(ws2UniqueIDCol & j) & ws2.Range(ws2LineIdCol & j)
                 If (searchKey = foundKey) Then
                    ws1.Range(ws1ValToWriteCol & i).Value2 = ws2.Range(ws2ValToCopyCol & j).Value2
                    Exit For
                 End If
            Next
        End If
    Next

End Sub

代码显性问题：工作表引用函数sheetS拼写错误（正确为Sheets）、ws2StartRow变量未定义赋值、无Sheet3结果输出逻辑、无数量值比对分支、匹配键无分隔符易出现跨字段误匹配。

修正后完整可运行代码 #

Sub CompareAndExportMismatch()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Long, j As Long, startRow As Long, ws1EndRow As Long, ws2EndRow As Long, outputRow As Long
    Dim searchKey As String, foundKey As String
    Dim ws1Qty As Double, ws2Qty As Double
    Dim matchFound As Boolean
    
    ' 初始化工作表
    Set ws1 = Sheets("S1") ' 主记录表
    Set ws2 = Sheets("S2") ' 待比对表
    ' 初始化结果表，不存在则自动新建
    On Error Resume Next
    Set ws3 = Sheets("S3")
    If ws3 Is Nothing Then
        Set ws3 = Sheets.Add(After:=ws2)
        ws3.Name = "S3"
    End If
    On Error GoTo 0
    ws3.Cells.Clear
    ' 写入结果表表头
    ws3.Range("A1:D1") = Array("产品编号", "主记录表数量", "待比对表数量", "异常类型")
    outputRow = 2
    
    ' 配置项：可根据实际表结构调整
    startRow = 2 ' 数据从第2行开始，第1行为表头
    Const ws1ProductCol As String = "A", ws1SerialCol As String = "C", ws1QtyCol As String = "D"
    Const ws2ProductCol As String = "A", ws2SerialCol As String = "C", ws2QtyCol As String = "D"
    
    ' 获取两表数据末行
    ws1EndRow = ws1.UsedRange.Rows(ws1.UsedRange.Rows.Count).Row
    ws2EndRow = ws2.UsedRange.Rows(ws2.UsedRange.Rows.Count).Row
    
    ' 逐行遍历主表比对
    For i = startRow To ws1EndRow
        ' 匹配键加|分隔，避免跨字段拼接误匹配
        searchKey = ws1.Range(ws1ProductCol & i).Value & "|" & ws1.Range(ws1SerialCol & i).Value
        If Len(Trim(searchKey)) > 1 Then ' 跳过空行
            matchFound = False
            ws1Qty = Val(ws1.Range(ws1QtyCol & i).Value)
            ' 在待比对表查找匹配项
            For j = startRow To ws2EndRow
                foundKey = ws2.Range(ws2ProductCol & j).Value & "|" & ws2.Range(ws2SerialCol & j).Value
                If searchKey = foundKey Then
                    matchFound = True
                    ws2Qty = Val(ws2.Range(ws2QtyCol & j).Value)
                    ' 数量不一致则写入结果表
                    If ws1Qty <> ws2Qty Then
                        ws3.Cells(outputRow, 1) = ws1.Range(ws1ProductCol & i).Value
                        ws3.Cells(outputRow, 2) = ws1Qty
                        ws3.Cells(outputRow, 3) = ws2Qty
                        ws3.Cells(outputRow, 4) = "数量不匹配"
                        outputRow = outputRow + 1
                    End If
                    Exit For
                End If
            Next j
            ' 未找到匹配项也写入结果表
            If Not matchFound Then
                ws3.Cells(outputRow, 1) = ws1.Range(ws1ProductCol & i).Value
                ws3.Cells(outputRow, 2) = ws1Qty
                ws3.Cells(outputRow, 3) = "无记录"
                ws3.Cells(outputRow, 4) = "待比对表缺失对应条目"
                outputRow = outputRow + 1
            End If
        End If
    Next i
    
    ' 自动调整列宽，弹出完成提示
    ws3.UsedRange.Columns.AutoFit
    MsgBox "比对完成，共发现 " & outputRow - 2 & " 条异常记录，已导出至S3工作表", vbInformation
End Sub

使用注意事项 #

• 运行前请确认工作表名称、字段列位置、数据起始行与代码中配置项一致，如有差异直接修改配置部分参数即可，无需改动核心比对逻辑
• 匹配键增加了|作为分隔符，解决产品编号与序列号拼接时的误匹配问题
• 每次运行宏会自动清空S3表的历史比对结果，无需手动清理
• 除数量不匹配条目外，待比对表中缺失的主表条目也会被同步标记导出，覆盖全量异常场景

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