VBA検証でブックがクラッシュする

Question

選択したオプションに依存するセルの検証を変更するVBAコードがあります。

Sub Worksheet_Change(ByVal Target As Range) 
    Dim ws As Worksheet 
    Set ws = Sheets("lkup") 

    Dim VariationList As Variant 
    VariationList = Application.Transpose(ws.Range("Resource_List")) 
    For i = LBound(VariationList) To UBound(VariationList) 

    Next i 
     If Target = Range("B15") Then 
     If InStr(1, Range("B15"), "Resource") > 0 Then 
      With Range("D15").Validation 
       .Delete 
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
        Operator:=xlEqual, Formula1:=Join(VariationList, ",") 
       .IgnoreBlank = True 
       .InCellDropdown = True 
       .InputTitle = "" 
       .ErrorTitle = "" 
       .InputMessage = "" 
       .ErrorMessage = "" 
       .ShowInput = True 
       .ShowError = True 
      End With 
     ElseIf InStr(1, Range("B15"), "Fixed Asset") > 0 Then 
      Range("D15").Validation.Delete 
      Range("D15").ClearContents 
      With Range("D15").Validation 
       .Delete 
       .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ 
        Operator:=xlBetween, Formula1:="100000", Formula2:="999999" 
       .IgnoreBlank = True 
       .InCellDropdown = True 
       .InputTitle = "" 
       .ErrorTitle = "Oopps" 
       .InputMessage = "" 
       .ErrorMessage = "Your fixed asset number can only be 6 numbers" 
       .ShowInput = True 
       .ShowError = True 
      End With 
     Else 
      Range("D15").ClearContents 
      Range("D15").Validation.Delete 
     End If 
    End If 
End Sub 

それワークブックが開いている間にに動作します。それはうまく機能する、エラーや何もない。ただし、ブックを保存して再度開くと、次のように表示されます。

「Invoice.xlsm」の内容に問題が見つかりました。 私たちができる限り回復しようとしますか？この ブックのソースを信頼する場合は、[はい]をクリックします。

次に、ブックを開き、すべての書式を削除し、VBAを削除します。

私はグーグルを試みましたが、私が持っているものにそれを翻訳することができませんでした。

乾杯、あなたがイベントをオフにする必要がWorksheet_Changeを使用してActiveSheetの値を変更する前に

Answer 1

。これにより、Worksheet_Changeが再度トリガーされなくなり、無限ループが発生する可能性があります。イベントが終了する前に電源を入れ直してください。

エラーハンドラを追加して何かがうまくいかない場合は、イベントが自動的に再びオンになるようにすることをお勧めします。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    On Error GoTo ResumeEvents 
    Application.EnableEvents = False 

    '----{Code}------ 
ResumeEvents: 
    Application.EnableEvents = True 
End Sub