object_Worksheet的方法“范围”失败错误-2147417848（80010108） [英] Method 'Range' of object_Worksheet failed error -2147417848 (80010108)

问题描述

我已经广泛搜索，但似乎没有找到任何关于我的问题。我有一个工作簿，各种VBA与单元格公式混合。因为它现在坐起来很好，但是如果我尝试添加或修改一个简单的单元格引用，例如= N24，它会打破我的代码并抛出错误：

运行时错误'-2147417848（80010108）'：object'_Worksheet的方法'范围'失败

这是不管我是引用计算单元格，用户填充单元格还是空白单元格。

这是表格计算代码，这是唯一的代码在这个特定的表。我知道这是基本的，但通常很简单。当它抛出这个错误时，它会中断：

 表（CALCULATIONS）。Range（N24）。ClearContents 
  

如果我删除该代码，那么它将在第一个IF语句行中断。我希望你们能够帮助我，因为我正在努力解决这个问题。感谢提前！

  Private Sub Worksheet_Calculate（）
 Dim SIZE As String 
 Dim THICKNESS As Single 
 Dim WIDTH As Single 
 Dim HEIGHT As Single 
 Dim WALL As Single 
 Dim WALL1 As String 
 Dim OD As Single 
 Dim FINALROW As Integer 
 Dim i As Integer 
 Sheets（CALCULATIONS）。Range（N24）。ClearContents 
如果ThisWorkbook.Sheets（SHEET1）。范围（E4）=STRUCTURAL_I_BEAM和ThisWorkbook .Sheets（SHEET1）。范围（F4）< 0然后
 
 Application.ScreenUpdating = False 
 Sheets（IBEAM）。Range（Q2：Q100）。ClearContents 
 SIZE = Sheets（SHEET1）。Range （F4）值
 FINALROW =表（IBEAM）。单元格（Rows.Count，2）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果工作表（IBEAM）。单元格（i，2）= SIZE然后
工作表（IBEAM）。单元格（i，8）.Copy 
表格（IBEAM）。 Range（Q& Rows.Count）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS）。 （N24）Value = Worksheets（IBEAM）。Range（Q2）。value 
 Application.ScreenUpdating = True 
 End If 
 
 
如果ThisWorkbook.Sheets（SHEET1）。范围（E4）=STRUCTURAL_CHANNEL和ThisWorkbook.Sheets（SHEET1）。范围（F4）< 0然后
 
 Application.ScreenUpdating = False 
表格（CHANNEL）。Range（Q2：Q100）。ClearContents 
 SIZE = Sheets（SHEET1）。Range （F4）Value 
 FINALROW = Sheets（CHANNEL）。Cells（Rows.Count，2）.End（xlUp）.Row 
 
 For i = 2 To FINALROW 
如果工作表（CHANNEL）。单元格（i，2）= SIZE然后
工作表（CHANNEL）。单元格（i，6）.Copy 
表格（CHANNEL）。 Range（Q& Rows.Count）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS）。 （N24）Value = Worksheets（CHANNEL）。Range（Q2）。value 
 Application.ScreenUpdating = True 
 End If 
 
 
如果ThisWorkbook.Sheets（SHEET1）。范围（E4）=STRUCTURAL_ANGLE和ThisWorkbook.Sheets（SHEET1）。范围（F4）& 0然后
 
 
 Application.ScreenUpdating = False 
表格（ANGLE）。Range（Q2：Q100）。ClearContents 
 WIDTH = Sheets（SHEET1 ）.Range（F4）值
 HEIGHT = Sheets（SHEET1）。范围（G4）值
 THICKNESS =表（SHEET1）。范围（H4 ）.Value 
 FINALROW = Sheets（ANGLE）。Cells（Rows.Count，3）.End（xlUp）.Row 
 
 For i = 2 To FINALROW 
 If单元格（i，3）= WIDTH和工作表（ANGLE）单元格（i，4）= HEIGHT和Worksheets（ANGLE）。单元格（i，6）= THICKNESS然后
工作表（ANGLE）。单元格（i，7）.Copy 
表格（ANGLE）。范围（Q& Rows.Count）.End（xlUp）.Offset（1，0 ）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS）。Range（N24）。Value = Worksheets（ANGLE）。Range（Q2）。价值
 Application.ScreenUpdating = True 
如果
 
 
如果ThisWorkbook.Sheets（SHEET1）。Range（E4）=TUBE_RECTANGLEAnd Thisbook .Sheets（SHEET1）。范围（F4）< 0然后
 
 
 Application.ScreenUpdating = False 
表（RECTTUBE）。范围（Q2：Q100）。ClearContents 
 WIDTH = Sheets（SHEET1 ）.Range（F4）值
 HEIGHT = Sheets（SHEET1）。Range（G4）。value 
 WALL = Sheets（SHEET1）。Range（H4 ）.Value 
 FINALROW = Sheets（RECTTUBE）。Cells（Rows.Count，3）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果工作表（RECTTUBE）。单元格（i，3）= WIDTH和工作表（RECTTUBE）。单元格（i，4）= HEIGHT和工作表（RECTTUBE）。单元格（i，5）= WALL然后
工作表（RECTTUBE）。单元格（i，6）.Copy 
表格（RECTTUBE）。范围（Q& Rows.Count）.End（xlUp）.Offset（1，0 ）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS）。Range（N24）。Value = Worksheets（RECTTUBE）。Range（Q2）。价值
 Application.ScreenUpdating = True 
如果
 
 
如果ThisWorkbook.Sheets（SHEET1）。Range（E4）=TUBE_SQUAREAnd Thisbook .Sheets（ SHEET1），范围（F4 ）<> 0然后
 
 
 Application.ScreenUpdating = False 
表（SQUARETUBE）。Range（Q2：Q100）。ClearContents 
 WIDTH = Sheets（SHEET1 ）.Range（F4）。值
 WALL = Sheets（SHEET1）。范围（H4）值
 FINALROW =表（SQUARETUBE）。单元格（Rows.Count ，3）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果Worksheets（SQUARETUBE）。Cells（i，3）= WIDTH和Worksheets（SQUARETUBE ）.Cells（i，5）= WALL Then 
 Worksheets（SQUARETUBE）。Cells（i，6）.Copy 
 Sheets（SQUARETUBE）。Range（Q& Rows。计数）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS）。Range（N24）。Value = Worksheets （SQUARETUBE）。Range（Q2）。value 
 Application.ScreenUpdating = True 
 End If 
 
 
如果ThisWorkbook.Sheets（SHEET1） .Range（E4）=TUBE_ROUND和ThisWorkbook.Sheets（SHEET1）。范围（F4）< 0然后
 
 
 Application.ScreenUpdating = False 
表单（ROUNDTUBE）。范围（Q2：Q100）。ClearContents 
 OD = Sheets（SHEET1 ）.Range（F4）。值
 WALL1 = Sheets（SHEET1）。范围（H4）值
 FINALROW =表（ROUNDTUBE）。 ，3）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果Worksheets（ROUNDTUBE）。Cells（i，3）= OD和Worksheets（ROUNDTUBE ）.Cells（i，4）= WALL1 Then 
 Worksheets（ROUNDTUBE）。Cells（i，5）.Copy 
 Sheets（ROUNDTUBE）。Range（Q& Rows。计数）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS）。Range（N24）。Value = Worksheets （ROUNDTUBE）。Range（Q2）。value 
 Application.ScreenUpdating = True 
如果
 
 
如果ThisWorkbook.Sheets（SHEET1） .Range（E4）=PIPE和ThisWorkbook.Sheets（SHEET1）。范围（F4）< 0然后
 
 
 Application.ScreenUpdating = False 
表（PIPE）。范围（Q2：Q100）。ClearContents 
 OD = Sheets（SHEET1 ）.Range（F4）。值
 WALL1 =表（SHEET1）。范围（H4）值
 FINALROW =表（PIPE）。单元格（Rows.Count ，3）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果Worksheets（PIPE）。Cells（i，3）= OD和Worksheets（PIPE ）.Cells（i，4）= WALL1 Then 
 Worksheets（PIPE）。Cells（i，5）.Copy 
 Sheets（PIPE）。Range（Q& Rows。计数）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS）。Range（N24）。Value = Worksheets （PIPE）。范围（Q2）。价值
 Application.ScreenUpdating = True 
如果
 
 
如果ThisWorkbook.Sheets（SHEET1） .Range（E4）=SOLID_ROUND和ThisWorkbook.Sheets（SHEET1）。范围（F4）< 0然后
 
 
 Application.ScreenUpdating = False 
表单（ROUND）。范围（Q2：Q100）。ClearContents 
 OD = Sheets（SHEET1 ）.Range（F4）。值
 FINALROW =表（ROUND）。单元格（Rows.Count，3）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果Worksheets（ROUND）。Cells（i，3）= OD Then 
 Worksheets（ROUND）。Cells（i，4）.Copy 
 Sheets ROUND）。Range（Q& Rows.Count）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS ）.Range（N24）。Value = Worksheets（ROUND）。Range（Q2）。value 
 Application.ScreenUpdating = True 
 End If 
 
 
如果ThisWorkbook.Sheets（SHEET1）。范围（E4）=SOLID_FLAT和ThisWorkbook.Sheets（SHEET1）。范围（F4）< 0然后
 
 
 Application.ScreenUpdating = False 
表格（FLAT）。Range（Q2：Q100）。ClearContents 
 THICKNESS = Sheets（SHEET1 ）.Range（F4）。值
 WIDTH =表（SHEET1）。范围（G4）值
 FINALROW =表（FLAT）。单元格（Rows.Count ，3）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果Worksheets（FLAT）。Cells（i，3）= THICKNESS AND Worksheets（FLAT ）.Cells（i，4）= WIDTH Then 
 Worksheets（FLAT）。Cells（i，5）.Copy 
 Sheets（FLAT）。Range（Q& Rows。计数）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS）。Range（N24）。Value = Worksheets （FLAT）。Range（Q2）。value 
 Application.ScreenUpdating = True 
 End If 
 
 
如果ThisWorkbook.Sheets（SHEET1） .Range（E4）=SOLID_SQUARE和ThisWorkbook.Sheets（SHEET1）。范围（F4）< 0然后
 
 
 Application.ScreenUpdating = False 
表格（SQUARE）。Range（Q2：Q100）。ClearContents 
 WIDTH = Sheets（SHEET1 ）.Range（F4）值
 FINALROW =表（SQUARE）。单元格（Rows.Count，3）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果工作表（SQUARE）。Cells（i，3）= WIDTH Then 
 Worksheets（SQUARE）。Cells（i，4）.Copy 
 Sheets SQUARE）。Range（Q& Rows.Count）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS ）.Range（N24）。Value = Worksheets（SQUARE）。Range（Q2）。value 
 Application.ScreenUpdating = True 
 End If 
 
 
如果ThisWorkbook.Sheets（SHEET1）。范围（E4）=SOLID_HEX和ThisWorkbook.Sheets（SHEET1）。范围（F4）< 0然后
 
 
 Application.ScreenUpdating = False 
表（HEX）。Range（Q2：Q100）。ClearContents 
 WIDTH = Sheets（SHEET1 ）.Range（F4）。值
 FINALROW =表（HEX）。单元格（Rows.Count，3）.End（xlUp）.Row 
 
对于i = 2到FINALROW 
如果Worksheets（HEX）。Cells（i，3）= WIDTH Then 
 Worksheets（HEX）。Cells（i，4）.Copy 
 Sheets HEX）。Range（Q& Rows.Count）.End（xlUp）.Offset（1，0）.PasteSpecial xlPasteValues 
 End If 
 Next i 
工作表（CALCULATIONS ）.Range（N24）Value =工作表（HEX）范围（Q2）值
工作表（CALCULATIONS）。Range（N25）。Value = Worksheets值（N8）值/ 12 *工作表（计算）范围（N24）值
工作表（CALCULATIONS）。范围（N26）。值=工作表（计算）范围（N25）值 - （（工作表（CALCULATIONS）范围（N6）值*工作表（计算 12）*工作表（计算） nge（N24）。Value）
 Application.ScreenUpdating = True 
 End If 
 
 
 End Sub 
  / pre> 
 
 
最初发布在 mrexcel 如果我违反了任何规则，请通知我，因为这不是我的意图。
解决方案
虽然Excel是忙碌计算单元格，但您正在尝试删除/更改单元格，调用另一个计算事件。因此阻塞单元/范围访问。相同的情况，您会发现图表与正常表格的混合。
 
 
 
在进行任何更改/删除之前，一旦完成重新启用事件，只需禁用该事件。 > 
 
 
  ............... 
 Dim i As Integer 
应用程序。 EnableEvents = False 
表格（CALCULATIONS）。范围（N24）。ClearContents 
 .........你的代码.... 
 ..... ................ 
 Application.ScreenUpdating = True 
 End If 
 
 Application.EnableEvents = True 
  
另一个选择是等到CalculationState是 xlDone ，但如果你太多冗长的计算，这可能会崩溃您的应用程序。
 
I've googled extensively, but can't seem to find anything on my problem. I have a workbook that has various VBA intermingled with in cell formulas. As it sits now it works fine, but if I try and add or modify a simple cell reference such as "=N24" it breaks my code and throws up the error:

  
Run-time error '-2147417848 (80010108)': Method 'Range' of object'_Worksheet' failed
This happens whether I'm referencing a calculated cell, a user filled cell, or a blank cell.

Here's the sheet calculate code, which is the only code on this particular sheet. I know it's rudimentary, but usually simple is good. When it throws this error, it breaks at:
Sheets("CALCULATIONS").Range("N24").ClearContents
If I remove that code, then it breaks at the first IF statement line. I hope you folks can help me, as I'm going spare trying to figure this out. Thanks in advance!
Private Sub Worksheet_Calculate()
Dim SIZE As String
Dim THICKNESS As Single
Dim WIDTH As Single
Dim HEIGHT As Single
Dim WALL As Single
Dim WALL1 As String
Dim OD As Single
Dim FINALROW As Integer
Dim i As Integer
Sheets("CALCULATIONS").Range("N24").ClearContents
If ThisWorkbook.Sheets("SHEET1").Range("E4") = "STRUCTURAL_I_BEAM" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then

Application.ScreenUpdating = False
Sheets("IBEAM").Range("Q2:Q100").ClearContents
SIZE = Sheets("SHEET1").Range("F4").Value
FINALROW = Sheets("IBEAM").Cells(Rows.Count, 2).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("IBEAM").Cells(i, 2) = SIZE Then
            Worksheets("IBEAM").Cells(i, 8).Copy
            Sheets("IBEAM").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("IBEAM").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "STRUCTURAL_CHANNEL" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then

Application.ScreenUpdating = False
Sheets("CHANNEL").Range("Q2:Q100").ClearContents
SIZE = Sheets("SHEET1").Range("F4").Value
FINALROW = Sheets("CHANNEL").Cells(Rows.Count, 2).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("CHANNEL").Cells(i, 2) = SIZE Then
            Worksheets("CHANNEL").Cells(i, 6).Copy
            Sheets("CHANNEL").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("CHANNEL").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "STRUCTURAL_ANGLE" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("ANGLE").Range("Q2:Q100").ClearContents
WIDTH = Sheets("SHEET1").Range("F4").Value
HEIGHT = Sheets("SHEET1").Range("G4").Value
THICKNESS = Sheets("SHEET1").Range("H4").Value
FINALROW = Sheets("ANGLE").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("ANGLE").Cells(i, 3) = WIDTH And Worksheets("ANGLE").Cells(i, 4) = HEIGHT And Worksheets("ANGLE").Cells(i, 6) = THICKNESS Then
            Worksheets("ANGLE").Cells(i, 7).Copy
            Sheets("ANGLE").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("ANGLE").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "TUBE_RECTANGLE" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("RECTTUBE").Range("Q2:Q100").ClearContents
WIDTH = Sheets("SHEET1").Range("F4").Value
HEIGHT = Sheets("SHEET1").Range("G4").Value
WALL = Sheets("SHEET1").Range("H4").Value
FINALROW = Sheets("RECTTUBE").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("RECTTUBE").Cells(i, 3) = WIDTH And Worksheets("RECTTUBE").Cells(i, 4) = HEIGHT And Worksheets("RECTTUBE").Cells(i, 5) = WALL Then
            Worksheets("RECTTUBE").Cells(i, 6).Copy
            Sheets("RECTTUBE").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("RECTTUBE").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "TUBE_SQUARE" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("SQUARETUBE").Range("Q2:Q100").ClearContents
WIDTH = Sheets("SHEET1").Range("F4").Value
WALL = Sheets("SHEET1").Range("H4").Value
FINALROW = Sheets("SQUARETUBE").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("SQUARETUBE").Cells(i, 3) = WIDTH And Worksheets("SQUARETUBE").Cells(i, 5) = WALL Then
            Worksheets("SQUARETUBE").Cells(i, 6).Copy
            Sheets("SQUARETUBE").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("SQUARETUBE").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "TUBE_ROUND" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("ROUNDTUBE").Range("Q2:Q100").ClearContents
OD = Sheets("SHEET1").Range("F4").Value
WALL1 = Sheets("SHEET1").Range("H4").Value
FINALROW = Sheets("ROUNDTUBE").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("ROUNDTUBE").Cells(i, 3) = OD And Worksheets("ROUNDTUBE").Cells(i, 4) = WALL1 Then
            Worksheets("ROUNDTUBE").Cells(i, 5).Copy
            Sheets("ROUNDTUBE").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("ROUNDTUBE").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "PIPE" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("PIPE").Range("Q2:Q100").ClearContents
OD = Sheets("SHEET1").Range("F4").Value
WALL1 = Sheets("SHEET1").Range("H4").Value
FINALROW = Sheets("PIPE").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("PIPE").Cells(i, 3) = OD And Worksheets("PIPE").Cells(i, 4) = WALL1 Then
            Worksheets("PIPE").Cells(i, 5).Copy
            Sheets("PIPE").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("PIPE").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "SOLID_ROUND" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("ROUND").Range("Q2:Q100").ClearContents
OD = Sheets("SHEET1").Range("F4").Value
FINALROW = Sheets("ROUND").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("ROUND").Cells(i, 3) = OD Then
            Worksheets("ROUND").Cells(i, 4).Copy
            Sheets("ROUND").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("ROUND").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "SOLID_FLAT" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("FLAT").Range("Q2:Q100").ClearContents
THICKNESS = Sheets("SHEET1").Range("F4").Value
WIDTH = Sheets("SHEET1").Range("G4").Value
FINALROW = Sheets("FLAT").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("FLAT").Cells(i, 3) = THICKNESS And Worksheets("FLAT").Cells(i, 4) = WIDTH Then
            Worksheets("FLAT").Cells(i, 5).Copy
            Sheets("FLAT").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("FLAT").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "SOLID_SQUARE" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("SQUARE").Range("Q2:Q100").ClearContents
WIDTH = Sheets("SHEET1").Range("F4").Value
FINALROW = Sheets("SQUARE").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("SQUARE").Cells(i, 3) = WIDTH Then
            Worksheets("SQUARE").Cells(i, 4).Copy
            Sheets("SQUARE").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("SQUARE").Range("Q2").Value
Application.ScreenUpdating = True
End If


If ThisWorkbook.Sheets("SHEET1").Range("E4") = "SOLID_HEX" And ThisWorkbook.Sheets("SHEET1").Range("F4") <> 0 Then


Application.ScreenUpdating = False
Sheets("HEX").Range("Q2:Q100").ClearContents
WIDTH = Sheets("SHEET1").Range("F4").Value
FINALROW = Sheets("HEX").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 2 To FINALROW
        If Worksheets("HEX").Cells(i, 3) = WIDTH Then
            Worksheets("HEX").Cells(i, 4).Copy
            Sheets("HEX").Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
    Worksheets("CALCULATIONS").Range("N24").Value = Worksheets("HEX").Range("Q2").Value
    Worksheets("CALCULATIONS").Range("N25").Value = Worksheets("CALCULATIONS").Range("N8").Value / 12 * Worksheets("CALCULATIONS").Range("N24").Value
    Worksheets("CALCULATIONS").Range("N26").Value = Worksheets("CALCULATIONS").Range("N25").Value - ((Worksheets("CALCULATIONS").Range("N6").Value * Worksheets("CALCULATIONS").Range("N10").Value / 12) * Worksheets("CALCULATIONS").Range("N24").Value)
Application.ScreenUpdating = True
End If


End Sub
This was originally posted at mrexcel  Please let me know if I violated any rules, as that wasn't my intent.
解决方案
While Excel is Busy calculating the cells, you are trying to delete/change the cell, invoking another calculation event. Hence blocking the cell/range access. Same will happen you had a mix of chart sheets with normal sheets.

Just disable the events before making any change/delete and once done re-enable events.
...............
Dim i As Integer
Application.EnableEvents = False
Sheets("CALCULATIONS").Range("N24").ClearContents
.........Your Code....
.....................
Application.ScreenUpdating = True
End If

Application.EnableEvents = True
Another alternative is to wait till CalculationState is xlDone but if you too many lengthy calculation, this might crash your application.

                        
这篇关于object_Worksheet的方法“范围”失败错误-2147417848（80010108）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！