需要 VBA 代码才能运行得更快

Question

我刚刚开始在 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

问题是：当我收到错误时，弹出错误消息需要很长时间，然后它会崩溃 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。