Excel VBA中Range未完全限定致1004运行时错误的求助

具体触发错误的问题点 #

• 语法缺失：两处计算最后行号的代码缺少闭合右括号，属于直接触发运行时错误的低级问题
• 对象未完全限定：With ws块内调用Find方法、初始化rngNewCol时，未加. 前缀，默认引用当前活动工作表对象，若活动工作表不是目标表，会直接触发对象定义错误
• 变量未声明：rngNewCol未在开头的变量定义区声明，默认类型为Variant，极易引发类型不匹配类1004错误
• 无返回值校验：未判断Find方法是否匹配到目标表头，若匹配失败，PeggedWBS/CostObject会被赋值为Nothing，后续调用Offset方法时直接报错
• 冗余错误调用：rngNewCol.Application.CutCopyMode = False 写法冗余，指定对象层级错误时会触发异常
• 无工作表存在性校验：直接按名称引用工作表，若工作簿中不存在对应名称的表，会直接触发下标越界类1004错误

修正后可直接运行的代码 #

Sub SAPMacro()
    Dim PeggedWBS As Range
    Dim CostObject As Range
    Dim rngHeaders As Range
    Dim ws As Worksheet
    Dim sFindHeader As String
    Dim sNewHeader As String
    Dim LastRow As Long
    ' 补充缺失的变量声明
    Dim rngNewCol As Range

    ' 处理Zbuyr导出表
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("Insert Zbuyr Export")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "未找到Insert Zbuyr Export工作表"
        Exit Sub
    End If

    Set rngHeaders = ws.Range("1:1")
    sFindHeader = "Pegged WBS"
    sNewHeader = "Pegged WBS Stripped"
    ' 表头匹配加全匹配规则，同时加返回值校验
    Set PeggedWBS = rngHeaders.Find(What:=sFindHeader, LookAt:=xlWhole)
    If PeggedWBS Is Nothing Then
        MsgBox "Zbuyr导出表中未找到Pegged WBS表头"
        Exit Sub
    End If

    With ws
        ' 补全括号、修正Find的对象限定
        LastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        PeggedWBS.Offset(0, 1).EntireColumn.Insert
        PeggedWBS.Offset(0, 1).Value = sNewHeader
        ' 修正rngNewCol的对象限定
        Set rngNewCol = .Range(PeggedWBS.Offset(1, 1), .Cells(LastRow, PeggedWBS.Offset(1, 1).Column))
        rngNewCol.Cells(1, 1).Formula = "=1+1"
        rngNewCol.FillDown
        rngNewCol.Copy
        rngNewCol.PasteSpecial Paste:=xlPasteValues
        ' 简化CutCopyMode的调用逻辑
        Application.CutCopyMode = False
    End With

    ' 处理Pegging导出表
    Set ws = Nothing
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("Insert Pegging Export")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "未找到Insert Pegging Export工作表"
        Exit Sub
    End If

    Set rngHeaders = ws.Range("1:1")
    sFindHeader = "Cost Object"
    sNewHeader = "Cost Object Stripped"
    Set CostObject = rngHeaders.Find(What:=sFindHeader, LookAt:=xlWhole)
    If CostObject Is Nothing Then
        MsgBox "Pegging导出表中未找到Cost Object表头"
        Exit Sub
    End If

    With ws
        LastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        CostObject.Offset(0, 1).EntireColumn.Insert
        CostObject.Offset(0, 1).Value = sNewHeader
        Set rngNewCol = .Range(CostObject.Offset(1, 1), .Cells(LastRow, CostObject.Offset(1, 1).Column))
        rngNewCol.Cells(1, 1).Formula = "=1+1"
        rngNewCol.FillDown
        rngNewCol.Copy
        rngNewCol.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub

核心修正逻辑 #

• 所有工作表引用统一加ThisWorkbook前缀，避免打开多工作簿时引用错对象
• With块内的方法、属性调用全部加. 前缀，彻底消除未限定对象的引用错误
• 关键节点（工作表存在性、表头匹配结果）全部加校验，避免空对象触发1004
• 补全所有缺失的语法括号、变量声明，消除语法类错误

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