VBA代码执行FillDown后意外跳转至SkipSheet标签问题求助

问题说明 #

我编写了一段VBA代码，核心功能如下：

• 识别活动工作簿中主表（lead sheet）已用区域的最后一行
• 遍历指定工作表数组，将各表的公式扩展到主表的最后一行
• 弹出消息框展示各工作表名称、最后行号（所有表应一致）和最后行日期列的值（所有表应一致），用于校验数据是否异常

异常场景：当目标工作表确实存在时，执行ws.Rows(lastRowTS & ":" & lastRowMD).FillDown语句后，代码会意外跳转到SkipSheet标签，导致RTN变量赋值错误，最终消息框出现误报。尝试用If Not ws Is Nothing Then包裹相关代码后，问题仍未解决。

原代码片段 #

' Loop through target sheets
For Each TS In TSs
    ' Try to set the target sheet
    On Error GoTo SkipSheet
    Set ws = AW.Sheets(TS)

            ' Find the column number where 'Date' appears in row 3
            Dim dateColumn As Long
            dateColumn = Application.Match("Date", ws.Rows(3), 0)
            
            ' Check if 'Date' is found in row 3
            If IsError(dateColumn) Then
                lastRowTS = "Date column not found"
                Else
            ' Get the last row of the target sheet in the determined column
                lastRowTS = ws.Cells(ws.Rows.Count, dateColumn).End(xlUp).Row
                lastRowVL = ws.Cells(lastRowTS, dateColumn).Value
            End If
        
            ' Extend formulas to the last row of the lead sheet
            ws.Rows(lastRowTS & ":" & lastRowMD).FillDown
            RTN = RTN & TS & " = " & lastRowTS & " - " & lastRowVL & vbCrLf
        
NextSheet:
Next TS
GoTo EndOfSheets

SkipSheet:
Set ws = Nothing
RTN = RTN & TS & " = No Sheet" & vbCrLf
Resume NextSheet

EndOfSheets:
    ' Display the message box
    MsgBox RTN

修改后尝试的代码片段 #

If Not ws Is Nothing Then
        ' Find the column number where 'Date' appears in row 3
        Dim dateColumn As Long
        dateColumn = Application.Match("Date", ws.Rows(3), 0)
        
        ' Check if 'Date' is found in row 3
        If IsError(dateColumn) Then
            lastRowTS = "Date column not found"
            Else
        ' Get the last row of the target sheet in the determined column
            lastRowTS = ws.Cells(ws.Rows.Count, dateColumn).End(xlUp).Row
            lastRowVL = ws.Cells(lastRowTS, dateColumn).Value
        End If
    
        ' Extend formulas to the last row of the lead sheet
        ws.Rows(lastRowTS & ":" & lastRowMD).FillDown
        RTN = RTN & TS & " = " & lastRowTS & " - " & lastRowVL & vbCrLf
    Else
        GoTo SkipSheet
    End If

问题根源分析 #

1. 错误处理范围过大：原代码中On Error GoTo SkipSheet的作用范围覆盖了整个循环体，除了工作表不存在的错误，其他任何运行时错误（比如公式填充范围无效、Match返回错误后变量类型冲突）都会触发跳转到SkipSheet标签，导致正常工作表被误标记为"No Sheet"。
2. 变量类型冲突：当dateColumn找不到"Date"时，lastRowTS被赋值为字符串"Date column not found"，后续用该字符串拼接行范围（lastRowTS & ":" & lastRowMD）会生成无效的行地址，执行FillDown时抛出错误，触发错误跳转。
3. 未校验范围有效性：如果lastRowTS大于等于lastRowMD，反向的行范围会触发运行时错误，同样会跳转到SkipSheet。

修正方案 #

' 遍历目标工作表数组
For Each TS In TSs
    ' 仅在获取工作表对象时启用临时错误处理
    On Error Resume Next
    Set ws = AW.Sheets(TS)
    On Error GoTo 0 ' 关闭全局错误处理，后续错误正常抛出
    
    If Not ws Is Nothing Then
        Dim dateColumn As Variant ' 用Variant接收Match结果，兼容错误返回值
        dateColumn = Application.Match("Date", ws.Rows(3), 0)
        
        If IsError(dateColumn) Then
            ' 直接记录错误信息，不修改行号变量
            RTN = RTN & TS & " = Date column not found" & vbCrLf
        Else
            Dim lastRowTS As Long
            lastRowTS = ws.Cells(ws.Rows.Count, dateColumn).End(xlUp).Row
            Dim lastRowVL As Variant
            lastRowVL = ws.Cells(lastRowTS, dateColumn).Value
            
            ' 校验填充范围的有效性
            If lastRowTS < lastRowMD Then
                ws.Rows(lastRowTS & ":" & lastRowMD).FillDown
                RTN = RTN & TS & " = " & lastRowTS & " - " & lastRowVL & vbCrLf
            Else
                RTN = RTN & TS & " = 无需填充（当前最后行≥主表最后行）" & vbCrLf
            End If
        End If
        Set ws = Nothing ' 释放工作表对象
    Else
        RTN = RTN & TS & " = No Sheet" & vbCrLf
    End If
Next TS

' 展示校验结果
MsgBox RTN

修正要点 #

• 缩小错误处理范围：仅在获取工作表时启用临时错误处理，避免其他错误误触发跳转。
• 修正变量类型：用Variant接收Match结果，避免类型冲突；行号变量严格使用Long类型，不赋值字符串。
• 添加范围校验：确保填充的行范围是有效的正向范围，避免无效操作触发错误。
• 移除冗余标签跳转：简化代码逻辑，避免不必要的流程分支。

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