毎回VBAスクリプトがクラッシュする

Question

私はExcelの初心者であり、リサーチの少しの経験から、別のセルに入力された値に基づいてセル内に値を生成するコードが見つかりました。コードは以下の通りです。しかし、ワークシートを少し変更するたびに、作業が停止し、シャットダウン後もリセットされずに再び開きます。

ご協力ありがとうございました。ありがとう！

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim EF As Range, t As Range, v As Variant 
    Dim r As Long 
    Set t = Target 
    Set EF = Range("E:F") 
    If Intersect(t, EF) Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
     r = t.Row 
     v = t.Value 
     If v = "" Then 
      Range("E" & r & ":F" & r).Value = "" 
     End If 
     If IsNumeric(v) Then 
      If Intersect(t, Range("F:F")) Is Nothing Then 
       t.Offset(0, 1).Value = v * 25.4 
      Else 
       t.Offset(0, -1).Value = v/25.4 
      End If 
     End If 
    Application.EnableEvents = True 
End Sub 

Answer 1

なぜ機能しないのですか？

あなたのコードにapplication.EnableEvents=Falseがあります。エラーが発生し、イベントが無効になると、イベントは無効のままです。何とかコードを動作させるには、以下を試してください。

実行モジュールで、この：

Option Explicit 

Sub TurnMeOn() 

    Application.EnableEvents = True 

End Sub 

あなたは、彼らが存在しているとき、バックEnableEventsをリセット良いエラーキャッチャーを、使用していることを確認して、あなたのコードでさらに作業します。

Option Explicit 

    Private Sub Worksheet_Change(ByVal Target As Range) 

     Dim EF   As Range 
     Dim t   As Range 
     Dim v   As Variant 
     Dim r   As Long 

     On Error GoTo Worksheet_Change_Error 

     Set t = Target 
     Set EF = Range("E:F") 

     If Intersect(t, EF) Is Nothing Then Exit Sub 
     Application.EnableEvents = False 
     r = t.Row 
     v = t.Value 
     Debug.Print Target.Address 

     If v = "" Then 
      Range("E" & r & ":F" & r).Value = "" 
     End If 

     If IsNumeric(v) Then 
      If Intersect(t, Range("F:F")) Is Nothing Then 
       t.Offset(0, 1).Value = v * 25.4 
      Else 
       t.Offset(0, -1).Value = v/25.4 
      End If 
     End If 
     Application.EnableEvents = True 

     On Error GoTo 0 
     Exit Sub 

Worksheet_Change_Error: 

     Application.EnableEvents = True 
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Worksheet_Change of VBA Document Tabelle1" 

    End Sub 

迅速かつ汚い修正、コードの作業がSet t = Target(1,1)にSet t = Targetを変更することであろうようにします。したがって、複数のセルが貼り付けられている場合、常に最初のセルでのみ機能します。

Answer 2

Application.EnableEvents = Trueを復元する方法は、@ Vityataの回答で既に与えられています。

t As RangeからTarget

v As Variant等しい - 等しくTarget.Value

r As LongからTarget.Row

は、あなただけの「クリーナーを使用することができます等しい：

しかし、あなたのコードは非常に多くの不必要な変数で構成されてい以下のバージョン：

Private Sub Worksheet_Change(ByVal Target As Range) 

    If Not Intersect(Target, Range("E:F")) Is Nothing Then 
     Application.EnableEvents = False 

     If Target.Value = "" Then 
      Range("E" & Target.Row & ":F" & Target.Row).Value = "" 
     End If 
     If IsNumeric(Target.Value) Then 
      If Intersect(Target, Range("F:F")) Is Nothing Then 
       Target.Offset(0, 1).Value = Target.Value * 25.4 
      Else 
       Target.Offset(0, -1).Value = Target.Value/25.4 
      End If 
     End If 
     Application.EnableEvents = True 
    End If 

End Sub