需要VBA代码运行更快

我刚刚开始在Excel中编写代码，这是我的：

Public strKeyword Sub DataSearch() Dim strKeyword As String strKeyword = ActiveSheet.Range("B4").Value strKeyword = "*" & strKeyword & "*" Application.ScreenUpdating = False Worksheets("List_of_Incidents").Visible = True Worksheets("List_of_Incidents").Select ActiveSheet.Range("$B$1:$B$500").AutoFilter Field:=1 Range("B1").Select With ActiveSheet .AutoFilterMode = False With Range("B1", Range("B" & Rows.Count).End(xlUp)) .AutoFilter 1, strKeyword, xlAnd End With AutoFilterMode = False End With CopyVisibleCells End Sub Sub CopyVisibleCells() Range("B1:D1").Select Range(Selection, Selection.End(xlDown)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Sheets("Search").Select Range("A9:C9").Select Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False Columns("A:A").EntireColumn.AutoFit Rows("8:8").EntireRow.AutoFit Range("A8").Select Application.CutCopyMode = False If Range("A10") = "" Then ErrCapture Range("B4:B5").Select Worksheets("List_of_Incidents").Visible = False End Sub Sub ErrCapture() MsgBox ("Invalid Search! Please click New Search and Try Again") Exit Sub End Sub 

问题是：当我得到一个错误，它需要永远的错误消息popup，然后崩溃的Excel（没有响应）是任何人都可以帮助我解决这个问题。

Answer 1

我重构了你的代码，并删除了不必要的操作。

 Sub DataSearch() Dim rFilteredData As Range Dim strKeyword As String strKeyword = "*" & Range("B4").Value & "*" Application.ScreenUpdating = False With Worksheets("List_of_Incidents") .AutoFilterMode = False .Range("B1", .Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, strKeyword, xlAnd Set rFilteredData = Intersect(.Range("B:D"), .UsedRange) rFilteredData.Copy Sheets("Search").Range("A9").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False AutoFilterMode = False End With Application.ScreenUpdating = True End Sub 

Answer 2

它崩溃的Excel（没有响应）是任何人都可以帮助我解决这个问题。

 Application.ScreenUpdating = False 

是的，你必须重新打开ScreenUpdating。