object_worksheet 的方法范围失败 1004

Posted 2023-04-12

【中文标题】object_worksheet 的方法范围失败 1004

【英文标题】：Method Range of object_worksheet failed 1004

【发布时间】：2015-04-22 14:54:21

【问题描述】：

我编写了一些代码，当我调试它时它可以完美运行。但是当我删除断点并运行代码时，它会给出运行时错误：

运行时错误“1004” object_worksheet 的方法范围失败。

指的是下一行：

Set copyrange = sh.Range("A" & i & ":E" & i & ",I" & i & ":O" & i & ",Q" & i & ",V" & i) 'name column in sheet  = Q

但是在调试它时，没有问题。也许缓存已满？

Private Sub btnGetDevices_Click()
'open every sheet after summary
'copy columns A,B,C,D,E,I,J,K,L,M,N,O, Q,V to summary

Dim sh As Worksheet
Dim copyrange As Range

Application.ScreenUpdating = False
Sheets("Summary").Rows(4 & ":" & Sheets("Summary").Rows.Count).Delete
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "Database" And sh.Name <> "Template" And sh.Name <> "Help" And sh.Name <> "OVERVIEW" And sh.Name <> "Develop" And sh.Name <> "Schedule" And sh.Name <> "Information" And sh.Name <> "Announcements" And sh.Name <> "Summary" Then
        sh.Select
        LastRow = ActiveSheet.Range("L1048555").End(xlUp).Row

        For i = 14 To LastRow

              If sh.Range("Q" & i).Value <> Empty And sh.Range("N" & i).Value <> "Designer" And sh.Range("O" & i).Value <> "Layouter" Then
              Set copyrange = sh.Range("A" & i & ":E" & i & ",I" & i & ":O" & i & ",Q" & i & ",V" & i) 'name column in sheet  = Q
              NameDevice = sh.Range("Q" & i).Value
              adressDevice = sh.Range("Q" & i)
              copyrange.Copy
              Sheets("Summary").Select

              LastRowsummary = ActiveSheet.Range("A1048555").End(xlUp).Row
              Range("B" & LastRowsummary + 1).Select
              ActiveSheet.Paste
              Range("A" & LastRowsummary + 1) = sh.Name
              Range("A" & LastRowsummary + 1, "O" & LastRowsummary + 1).Borders.LineStyle = xlContinuous

              Sheets("Summary").Hyperlinks.Add anchor:=Sheets("Summary").Range("N" & LastRowsummary + 1), Address:="", SubAddress:="'" & sh.Name & "'!A1", TextToDisplay:=NameDevice
              End If



        Next


    End If


Next
Application.ScreenUpdating = True

Sheets("Summary").Activate

End Sub

*edit：经过一些测试，我注意到当我使用全范围的列而不是仅使用某些列时，错误消失了。

有错误：

Set copyrange = sh.Range("A" & i & ",V" & i)

没有错误：

Set copyrange = sh.Range("A" & i & ":E" & i)

*第二次编辑：

我正在使用来自“Tim Williams”的代码。有同样的错误。而不是使用：

rw.Range("A1:E1,I1:O1,Q1,V1").Copy rng.Offset(0, 1)

我找到了解决方法。我把它分开了。

rw.Range("I1:O1").Copy rng.Offset(0, 6)
rw.Range("Q1").Copy rng.Offset(0, 13)
rw.Range("V1").Copy rng.Offset(0, 14)

现在这可以正常工作了。但是，如果有人知道导致问题的原因，您可以随时分享。提前致谢。

*第三次编辑：

我仍然不知道为什么它不起作用。它与不同列的范围有关。有趣（也是非常沮丧的部分）是我在另一张纸上以这种方式使用范围，我没有这个问题。它快把我逼疯了。有人有想法吗？

【问题讨论】：

我的眼睛受伤了！在使用ActiveSheet 引用单元格之前停止使用select。尝试改用Sheets("Summary").Range("A1048555").End(xlUp).Row

ActiveSheet 和 ActiveWorkbook 是 它在调试时有效但在运行时无效的好朋友。遵循@Gareth 的建议，去掉Active 的东西，改用唯一的引用。您需要正确调试它，即没有Active 的东西闪烁代码。

感谢您的提示，但即使我摆脱了活跃的东西，我仍然会遇到同样的错误。

【参考方案1】：

已编译但未测试"

Private Sub btnGetDevices_Click()
'open every sheet after summary
'copy columns A,B,C,D,E,I,J,K,L,M,N,O, Q,V to summary

Dim sh As Worksheet, shtsumm As Worksheet
Dim copyrange As Range, arrExclude, rw As Range
Dim lastRow As Long, i As Long, rng As Range
Dim NameDevice, adressDevice

    'sheets to ignore
    arrExclude = Array("Database", "Template", "Help", "OVERVIEW", _
                      "Develop", "Schedule", "Information", "Announcements", _
                      "Summary")

    Set shtsumm = Sheets("Summary")

    Application.ScreenUpdating = False

    shtsumm.Rows(4 & ":" & shtsumm.Rows.Count).Delete
    For Each sh In ActiveWorkbook.Worksheets

        If IsError(Application.Match(sh.Name, arrExclude, 0)) Then

            lastRow = sh.Cells(sh.Rows.Count, "L").End(xlUp).Row

            For i = 14 To lastRow

                  Set rw = sh.Rows(i)

                  If rw.Cells(1, "Q").Value <> Empty And _
                     rw.Cells(1, "N").Value <> "Designer" And _
                     rw.Cells(1, "O").Value <> "Layouter" Then

                      NameDevice = rw.Range("Q1").Value
                      adressDevice = rw.Range("Q1").Value '<<<typo ?

                      'find destination
                      Set rng = shtsumm.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

                      rng.Value = sh.Name
                      'Here Range is relative to *rw*, not to the whole sheet
                      rw.Range("A1:E1,I1:O1,Q1,V1").Copy rng.Offset(0, 1)
                      rng.Resize(1, 15).Borders.LineStyle = xlContinuous

                      shtsumm.Hyperlinks.Add _
                         anchor:=rng.EntireRow.Cells(1, "N"), _
                         Address:="", SubAddress:="'" & sh.Name & "'!A1", _
                         TextToDisplay:=NameDevice
                  End If
            Next
        End If
    Next

    Application.ScreenUpdating = True

    shtsumm.Activate

End Sub

【讨论】：

感谢您的回复。这段代码比我写的要干净得多。但是我在同一个地方仍然有同样的错误。

@VeVi - 我可以在 Excel 2010 中毫无问题地运行它Sheet1.Range("A1:E1,I1:O1,Q1,V1").Copy Sheet2.Range("A1") 你使用的是什么版本的 Excel？

好吧，我有一个非常奇怪的问题。在 1 页我使用这样的范围，没有问题。但是在这个页面上它不起作用。我真的不明白。我使用 excel 2010。

除非您可以共享您的工作簿，否则我无法提供更多建议，而且无论如何您似乎都有解决方法。

非常感谢您的帮助和建议！目前它有效，当我有更多时间时，我会更深入地研究它;o）