由于VBA代码，工作簿变慢并崩溃？ 无论如何要停止/加快这一点？
我的工作表中有下面的代码。 该代码导致电子表格工作缓慢和崩溃，并且还需要很长时间才能打开。 我是VBA的新品牌，可能无法正确编码。 有没有更好的方法来构build我的代码，以防止这种情况发生？
Option Explicit Option Compare Text Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo Message ActiveSheet.DisplayPageBreaks = False If Target.Address = "$K$3" Then If Range("A" & Rows.Count).End(xlUp).Row < 5 Then Range("A5").Select Else Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select End If End If If Target.Address = "$I$3" Then If Range("A" & Rows.Count).End(xlUp).Row < 5 Then Range("A5").Select Else Range("A9").Select End If End If If Target.Address = "$N$2" Then If Range("A" & Rows.Count).End(xlUp).Row < 5 Then Range("A5").Select Else Range("A7").Select End If End If 'Clear Search Box If Target.Address = "$N$3:$O$3" Then Target.Value = "" End If Exit Sub Message: Application.DisplayAlerts = False Exit Sub End Sub Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Message On Error Resume Next ActiveSheet.DisplayPageBreaks = False 'Insert Depot Memo Data for user Dim oCell As Range, targetCell As Range Dim ws2 As Worksheet On Error GoTo Message If Not Intersect(Target, Range("B:B")) Is Nothing Then ' <-- run this code only if a value in column I has changed If Not GetWb("Depot Memo", ws2) Then Exit Sub With ws2 For Each targetCell In Target Set oCell = .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)).Find(What:=targetCell.Value, LookIn:=xlValues, LookAt:=xlWhole) If Not oCell Is Nothing Then Application.EnableEvents = False 'Set Format of cell targetCell.Font.Name = "Arial" targetCell.Font.Size = "10" With targetCell.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Color = RGB(192, 0, 0) .Weight = xlMedium End With With targetCell.Borders(xlEdgeRight) .LineStyle = xlContinuous .Color = RGB(192, 0, 0) .Weight = xlMedium End With With targetCell.Borders(xlEdgeTop) .LineStyle = xlContinuous .Color = RGB(191, 191, 191) .Weight = xlThin End With With targetCell.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Color = RGB(191, 191, 191) .Weight = xlThin End With targetCell.Offset(0, -1).Value = Now() targetCell.Offset(0, 1).Value = oCell.Offset(0, 1) targetCell.Offset(0, 2).Value = oCell.Offset(0, -2) targetCell.Offset(0, 3).Value = oCell.Offset(0, -7) Application.EnableEvents = True End If Next End With End If 'Prompt missed on sale If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value = "Issue Complete" Then If Target.Cells.Count < 8 Then Dim MSG1 As Variant MSG1 = MsgBox("Did Item Miss On-Sale?", vbYesNo, "Feedback") If MSG1 = vbYes Then Range("O" & ActiveCell.Row).Value = "Yes" Else Range("O" & ActiveCell.Row).Value = "No" End If Range("P" & ActiveCell.Row).Value = Date - Range("A" & ActiveCell.Row).Value End If End If If Not Intersect(Target, Range("D" & ActiveCell.Row)) Is Nothing And Target.Value <> "" Then Call PhoneBook2 End If 'Send Email - Receipt of Issue Application.ScreenUpdating = False Application.DisplayAlerts = False If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value <> "" Then If Target.Cells.Count < 4 Then Call SendEmail0 End If End If 'Send Email - Status Change Application.ScreenUpdating = False Application.DisplayAlerts = False If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value <> "" Then If Target.Cells.Count < 4 Then Call SendEmail End If End If Application.ScreenUpdating = True Application.DisplayAlerts = True Exit Sub Message: Application.DisplayAlerts = False Exit Sub End Sub Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) If ActiveCell.Value = "(Turn Off Emails)" Then UserForm1.Show End If End Sub Function GetWb(wbNameLike As String, WS As Worksheet) As Boolean Dim Wb As Workbook For Each Wb In Workbooks If Wb.Name Like "*" & wbNameLike & "*" Then '<-- check if workbook name contains "Depot Memo" Set WS = Wb.Worksheets(1) Exit For End If Next GetWb = Not WS Is Nothing End Function 当您在select更改事件代码中select一个单元格时，select更改事件会再次触发。 如果在“换页事件”中更改单元格的值，则会发生同样的事件，同样的事件会再次触发。 所以后台事件代码被多次触发，代码执行速度慢。
为了解决这个问题，你应该使用Application.EnableEvents = False来避免事件代码被再次触发。 但请记住通过Application.EnableEvents = True再次启用事件