メソッドobject_Worksheetの 'Range'エラーがエラー-2147417848（80010108）です。

私は大規模にGoogleで検索しましたが、私の問題で何かを見つけることはできません。私はセルの数式で混在している様々なVBAを持っているワークブックを持っています。それが座っているとして、今では正常に動作しますが、私がしようとするなどの単純なセル参照を追加または変更した場合、「= N24は、」それは私のコードを壊すとエラーアップスロー：メソッドobject_Worksheetの 'Range'エラーがエラー-2147417848（80010108）です。

Run-time error '-2147417848 (80010108)': Method 'Range' of object'_Worksheet' failed

これは私が参照してるかどうかが起こると計算セル、ユーザ充填セル、またはブランクセルである。

ここにシート計算コードがあります。これはこのシートの唯一のコードです。私はそれが初歩的だと知っていますが、通常はシンプルです。このエラーが発生すると、次の場所でエラーが発生します。

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で投稿されました。

出典

2017-02-08 allidoisthrow

最初のチェックと同じように、奇妙なエラーが発生しているように、シートの行にThisWorkbookを書いてシートをワークシートに変更できますか？だからThisWorkbook。ワークシート（「計算」）。また、ブックに「SHEET1」というシートが常に含まれることを確認できますか？ – Zerk

私は最初、無駄にしようとしました。私はおそらく私の最初の質問で多くを言っていたはずです。見てくれてありがとう！ – allidoisthrow

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あるまで待つことですが、あなた、あまりにも多くの長い計算ならば、これはあなたのアプリケーションをクラッシュする可能性があります。

出典

2017-02-08 18:14:45 cyboashu

私は提案されたようにコードを追加しましたが、これまでのところこれは保持されているようです。迅速な対応に感謝します！ – allidoisthrow

無限ループが発生するため、もちろんRange（ "N24"）の参照を入れることはできません。

あなたのコードの最初の行は、そのための証拠である：

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

なぜ、あなたはレンジ（「N24」）の参照を入れて、あなたがClearContents消去のためのあなたのラインよりも、Changeイベントを解雇ENTER]をクリックしているため内容とその後、あなたはこのリファレンスであなたのセルで計算を取得しています、そして、ここで私たちは再びChange Eventを起こしました。そんなことに（無限ループ）。

私はあなたのところで次のことを試みました。例えば、編集のために

のコード行：この

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

エンドと

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

たとえば上記のようなClearContents編集とコードのすべての部分。

これにより、無限ループが発生しないことが保証されます。

幸運を祈る！

出典

2017-02-08 18:35:07

私はこの変更を示唆したように試みましたが、同じエラーが発生しました。 = N24は単なる（悪い）例でした。それは私が計算を引き起こす何かを試して入力するときに起こります。これまでのところ、サイオバシュの提案は保持されているようだ。迅速な対応に感謝します！ – allidoisthrow

メソッドobject_Worksheetの 'Range'エラーがエラー-2147417848（80010108）です。

答えて

関連する問題