计算列最后一行时触发Application defined or object defined error的排查求助

可能的错误原因及对应解决办法 #

1. 目标工作簿/工作表未正确引用 #

如果Workbook2.xlsx没打开，或者工作表名称不是Sheet1，会导致ws2对象引用失败，后续访问单元格时直接触发错误。

• 解决：确保目标工作簿已打开，或者在代码里添加路径自动打开；核对工作表名称的大小写、空格是否完全一致。可以加个判断逻辑：

  ' 检查工作簿是否打开，未打开则尝试用路径打开
  On Error Resume Next
  Set wb2 = Workbooks("Workbook2.xlsx")
  On Error GoTo 0
  If wb2 Is Nothing Then
      ' 替换成你实际的文件路径
      Set wb2 = Workbooks.Open("C:\YourFolder\Workbook2.xlsx")
  End If
  

2. 目标工作表被保护 #

如果Workbook2里的Sheet1处于保护状态，且没有开放单元格编辑权限，访问Cells属性会直接报错。

• 解决：手动解除保护，或者在代码里临时解除、操作后再恢复：

  ' 临时解除保护（有密码的话，在Unprotect后加密码参数，比如Unprotect "123456"）
  ws2.Unprotect
  ' 执行获取lastRow等操作
  lastRow = ws2.Cells(ws2.Rows.Count, "G").End(xlUp).Row
  ' 操作完成后重新保护
  ws2.Protect
  

3. lastRow变量类型溢出 #

Integer类型的最大值是32767，但Excel 2007及以上版本的工作表有1048576行，当lastRow超过32767时会触发溢出错误，间接导致原代码行报错。

• 解决：把lastRow的类型从Integer改成Long：

  Dim lastRow As Long ' 替换原来的Integer声明
  

4. 目标列G无数据 #

如果列G全是空值，End(xlUp)会定位到第1行，此时lastRow - 11会得到负数，后续粘贴的单元格范围会无效。虽然原错误是在获取lastRow时触发，但可以提前做个判断避免后续问题：

lastRow = ws2.Cells(ws2.Rows.Count, "G").End(xlUp).Row
' 防止lastRow太小导致计算出负数行号
If lastRow < 12 Then
    lastRow = 12
End If

修正后的完整代码 #

Sub DataTransfer()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow As Long ' 改用Long避免行数溢出

    ' 检查源工作簿是否存在
    On Error Resume Next
    Set wb1 = Workbooks("Workbook1.xlsm")
    On Error GoTo 0
    If wb1 Is Nothing Then
        MsgBox "Workbook1.xlsm没打开，请先打开该文件！"
        Exit Sub
    End If

    ' 检查并打开目标工作簿
    On Error Resume Next
    Set wb2 = Workbooks("Workbook2.xlsx")
    On Error GoTo 0
    If wb2 Is Nothing Then
        ' 替换成实际文件路径
        Set wb2 = Workbooks.Open("C:\YourFolder\Workbook2.xlsx")
        If wb2 Is Nothing Then
            MsgBox "找不到Workbook2.xlsx，请检查路径！"
            Exit Sub
        End If
    End If

    ' 检查工作表是否存在
    On Error Resume Next
    Set ws1 = wb1.Worksheets("Sheet1")
    Set ws2 = wb2.Worksheets("Sheet1")
    On Error GoTo 0
    If ws1 Is Nothing Or ws2 Is Nothing Then
        MsgBox "指定的工作表不存在，请核对名称！"
        Exit Sub
    End If

    ' 临时解除工作表保护（有密码的话自行添加）
    ws2.Unprotect

    ' 获取列G最后一行行号
    lastRow = ws2.Cells(ws2.Rows.Count, "G").End(xlUp).Row

    ' 处理行号过小的情况
    If lastRow < 12 Then
        lastRow = 12
    End If

    ' 复制粘贴值
    ws1.Range("B3:P16").Copy
    ws2.Range("G" & lastRow - 11 & ":P" & lastRow + 1).PasteSpecial Paste:=xlPasteValues

    ' 恢复工作表保护（有密码的话自行添加）
    ws2.Protect

    ' 清除剪贴板
    Application.CutCopyMode = False
End Sub

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