VBA分支列表比对代码首次运行报错、二次运行正常的原因排查

• 需求：比对两个列表的缺失分支名称
  1. 主列表：对应工作表Branch List
  2. 待同步列表：对应工作表P&L（注意不是P&L List），其分支名称由主列表提供，后续需同步主列表的增删操作
• 分支展示形式：P&L中的分支名称以行形式展示
• 代码逻辑：
  1. 将P&L第5行的分支名称转置到P&L List的A列
  2. 删除P&L List的空行
  3. 比对P&L List和Branch List的分支名称，在Compare工作表展示差异：
     • A列：仅在P&L存在的分支
     • B列：仅在Branch List存在的分支
• 异常现象：代码首次运行报错，第二次运行正常

原代码 #

Sub FindDifferences()

    Dim i As Long, ii As Long, sq1 As Variant, sq2 As Variant, m As Long


    sq1 = ActiveWorkbook.Worksheets("Branch List").Cells(1).CurrentRegion.Columns(1)
    sq2 = ActiveWorkbook.Worksheets("P&L List").Cells(1).CurrentRegion.Columns(1)


    ActiveWorkbook.Worksheets("Compare").Columns(1).ClearContents

    ActiveWorkbook.Worksheets("P&L").Activate
    Range("5:5").Select
    Selection.Copy
    ActiveWorkbook.Worksheets("P&L List").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    For i = 1 To UBound(sq1)
        ii = 0
        On Error Resume Next
        ii = Application.Match(sq1(i, 1), sq2, 0)
        On Error GoTo 0
        If ii = 0 Then
            m = m + 1
            ActiveWorkbook.Sheets("Compare").Cells(m, 2).Value = sq1(i, 1)
        End If
    Next


    For i = 1 To UBound(sq2)
        ii = 0
        On Error Resume Next
        ii = Application.Match(sq2(i, 1), sq1, 0)
        On Error GoTo 0
        If ii = 0 Then
            m = m + 1
            ActiveWorkbook.Sheets("Compare").Cells(m, 1).Value = sq2(i, 1)
        End If
    Next

End Sub

核心问题是数据读取顺序错误：

• 代码一开始就把P&L List的旧数据读取到sq2变量中，但此时P&L List还没被更新（更新操作在读取之后）
• 首次运行时，sq2存储的是无效的旧数据（比如首次运行前P&L List为空，UBound(sq2)会直接报错）
• 第二次运行时，P&L List已经被第一次运行的代码更新为有效数据，此时读取的sq2是正确的，所以能正常执行

另外还有两个潜在风险：

1. SpecialCells(xlCellTypeBlanks)如果找不到空行会触发报错
2. 使用Activate和Select依赖工作表当前状态，容易因切换出错

调整数据读取顺序，移除不必要的Activate/Select，并增加空行处理的错误捕获：

Sub FindDifferences()
    Dim wsBranch As Worksheet, wsPL As Worksheet, wsPLList As Worksheet, wsCompare As Worksheet
    Dim sq1 As Variant, sq2 As Variant
    Dim i As Long, ii As Long, m As Long
    
    ' 绑定工作表对象，避免依赖Activate/Select
    Set wsBranch = ThisWorkbook.Worksheets("Branch List")
    Set wsPL = ThisWorkbook.Worksheets("P&L")
    Set wsPLList = ThisWorkbook.Worksheets("P&L List")
    Set wsCompare = ThisWorkbook.Worksheets("Compare")
    
    ' 先更新P&L List的最新数据
    wsPLList.Cells.Clear ' 清空旧数据
    wsPL.Rows(5).Copy
    wsPLList.Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    
    ' 安全删除空行：捕获找不到空行的错误
    On Error Resume Next
    wsPLList.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    ' 读取最新的比对数据到数组
    sq1 = wsBranch.Cells(1).CurrentRegion.Columns(1).Value
    sq2 = wsPLList.Cells(1).CurrentRegion.Columns(1).Value
    
    ' 清空Compare工作表的差异列
    wsCompare.Range("A:B").ClearContents
    
    ' 查找仅在Branch List存在的分支（写入B列）
    m = 0
    For i = 1 To UBound(sq1)
        ii = 0
        On Error Resume Next
        ii = Application.Match(sq1(i, 1), sq2, 0)
        On Error GoTo 0
        If ii = 0 Then
            m = m + 1
            wsCompare.Cells(m, 2).Value = sq1(i, 1)
        End If
    Next i
    
    ' 查找仅在P&L存在的分支（写入A列）
    m = 0 ' 重置计数器，让A列从第1行开始
    For i = 1 To UBound(sq2)
        ii = 0
        On Error Resume Next
        ii = Application.Match(sq2(i, 1), sq1, 0)
        On Error GoTo 0
        If ii = 0 Then
            m = m + 1
            wsCompare.Cells(m, 1).Value = sq2(i, 1)
        End If
    Next i
End Sub

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