Need VBA-Code schneller läuft

Question

Ich habe gerade angefangen in Excel Codierung zu tun und das ist, was ich habe:

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 

Das Problem ist: Wenn ich einen Fehler, es dauert ewig für die Fehlermeldung an Pop-up, dann stürzt Excel (reagiert nicht) ist jemand in der Lage, mir helfen, das zu beheben.

Answer 1

Ich habe Ihren Code refaktoriert und alle unnötigen Operationen entfernt.

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

stürzt Excel (nicht reagiert) jemand in der Lage mir dabei helfen zu beheben.

Application.ScreenUpdating = False 

Ja, müssen Sie wieder ein ScreenUpdating zurück.