工作表變更事件VBA代碼和它崩潰excel 2013

Question

我已經打開一個新的問題後，人們已經幫我弄清楚如何解決我的第一個問題，現在我有一個新問題。您可以在下面的「啓動設備」頁面找到編碼。代碼第二部分到最後部分的想法是從B7：B和E7：E添加列（文本值）並將其顯示在J7：J列上。因此，如果將照片輸入到B並將通過輸入到列E中，則結果將成爲J列中的Photopass。如果通過宏命令運行，原始代碼工作正常。問題是我試圖將它添加到我現有的一些代碼中，現在當信息輸入到任何單元格時，整個程序都會崩潰。程序變得無響應，然後關閉並重新啓動。我沒有收到代碼或調試消息。以下是頁面上的完整代碼。

Private Sub Worksheet_Change(ByVal Target As Range) 

If Target.Column = 7 And UCase(Target.Value) = "YES" Then 
    Sheets("MESSAGE CHANGES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value 
    Application.Goto Sheets("MESSAGE CHANGES").Cells(Rows.Count, 1).End(xlUp).Offset(, 3) 

End If 


If Target.Column = 6 And UCase(Target.Value) = "YES" Then 
    Sheets("DEVICE NOTES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value 
    Application.Goto Sheets("DEVICE NOTES").Cells(Rows.Count, 1).End(xlUp).Offset(, 3) 

End If 


'(replace if new code fails)If Target.Column = 5 And UCase(Target.Value) = "FAIL" Or Target.Column = 5 And UCase(Target.Value) = "DAMAGED" Then 
    '(replace if new codes fails)Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value 
If Target.Column = 5 And UCase(Target.Value) = "FAIL" Or UCase(Target.Value) = "DAMAGED" Then 
    Application.EnableEvents = False 
    Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 5) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 5).Value 
    Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp).Offset(, 5) = Sheets("INITIATING DEVICES").Cells(Target.Row, 11).Value 
    Application.EnableEvents = True 


End If 
'code that will place date/time when value is selcted in E 
If Not Intersect(Target, Range("E:E")) Is Nothing Then 
    Range("I" & Target.Row).Value = Now 

End If 

Dim wb As Workbook 
Dim ws As Worksheet 
Dim lastRow As Long 

Set wb = ThisWorkbook 
Set ws = wb.Sheets("INITIATING DEVICES") 

lastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row 
ws.Range("J7:J" & lastRow).Value = Evaluate("=B7:B" & lastRow & "&E7:E" & lastRow) 


End Sub 


Private Sub Workbook_BeforePrint(Cancel As Boolean) 
With Sheets("INITIATING DEVICES") 
    .PageSetup.PrintArea = .Range("A1:H" & .Cells(Rows.Count, 1).End(xlUp).Row).Address 
End With 

End Sub 

謝謝你的任何幫助，你可以給我，如果你需要的信息了，我可以送檢驗文件，如果需要的話還提供更多的信息。我確信我搞砸了，這就是爲什麼它會一直崩潰。仍然在這裏學習。

Answer 1

如果它正在崩潰，則重複調用Change事件。您需要在適當的位置使用

以防止再次觸發Change事件，因爲您在工作表中進行更改（使用代碼）。