object_Worksheet的方法“范围”失败错误-2147417848(80010108)

我GOOGLE了广泛,但似乎无法find任何关于我的问题。 我有一个工作簿,有不同的VBA与单元格公式混杂在一起。 现在,它可以正常工作,但是如果我尝试添加或修改一个简单的单元格引用(如“= N24”),它会打破我的代码并抛出错误:

运行时错误'-2147417848(80010108)':object'_Worksheet'的方法'范围'失败

无论是引用计算的单元格,用户填充的单元格还是空白单元格,都会发生这种情况。

这里是工作表计算代码,这是这个特定工作表上唯一的代码。 我知道这是简单的,但通常很简单。 当它抛出这个错误,它打破了:

Sheets("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 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 

这是最初发布在mrexcel请让我知道,如果我违反任何规则,因为这不是我的意图。

当Excel忙于计算单元格时,您正尝试删除/更改单元格,并调用另一个计算事件。 因此阻止单元/范围访问。 同样会发生,你有一个正常床单的图表混合。

在进行任何更改/删除之前只需禁用事件,并且一旦完成重新启用事件。

 ............... Dim i As Integer Application.EnableEvents = False Sheets("CALCULATIONS").Range("N24").ClearContents .........Your Code.... ..................... Application.ScreenUpdating = True End If Application.EnableEvents = True 

另一种方法是等到CalculationState是xlDone但是如果您的计算太长,可能会导致应用程序崩溃。

当然,你不能把参考范围(“N24”),因为你会得到一个无限循环。

你的代码的第一行是这样的certificate:

 Sheets("CALCULATIONS").Range("N24").ClearContents 

为什么,因为你把范围的参考(“N24”),然后点击ENTER你会被解雇的Change事件,比你的ClearContents清除内容的行,之后,你有这个引用计算在你的单元格,在这里,我们再次发射改变事件,因为那个。 等等等等(一个无限循环)。

在你的地方,我试图做到以下几点。

例如编辑这行代码:

 Sheets("CALCULATIONS").Range("N24").ClearContents 

有了这个

 If Sheets("CALCULATIONS").Range("N24") <> "" Then Sheets("CALCULATIONS").Range("N24").ClearContents End If 

像上面的例子一样,用ClearContents编辑结束代码的每一部分。

这将确保无限循环的不出现。

祝你好运!