Question

我已经广泛搜索过，但似乎无法找到解决问题的方法。我有一个工作簿，其中有各种VBA与单元格公式混合在一起。现在它可以正常工作，但如果我尝试添加或修改一个简单的单元格引用，例如＆＃34; = N24＆＃34;它打破了我的代码并引发了错误：

运行时错误＆＃39; -2147417848（80010108）＆＃39;：方法＆＃39;范围＆＃39;对象＆＃39; _Worksheet＆＃39;失败

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

这里是工作表计算代码，这是此特定工作表上的唯一代码。我知道它很简陋，但通常很简单。当它抛出此错误时，它会在：

处中断

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如果我违反了任何规则，请与我们联系。因为这不是我的意图。

Answer 1

当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，但如果计算时间过长，可能会导致应用程序崩溃。

Answer 2

当然你不能引用Range（＆＃34; N24＆＃34;），因为你会得到一个无限循环。

代码的第一行就是证据：

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

为什么，因为你引用了Range（＆＃34; N24＆＃34;）并点击了ENTER你会被激活更改事件，而不是你的ClearContents擦除内容的行，之后你在你的单元格中使用这个参考和在这里，我们再次因为这个而被解雇了Change Event。依此类推等等（无限循环）。

在你的地方我试着做以下事。

例如编辑这行代码：

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

用这个

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

使用ClearContents编辑结束代码的每个部分，如上例所示。

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

祝你好运！

方法＆＃39;范围＆＃39; object_Worksheet失败错误-2147417848（80010108）

2 个答案: