Необходимость V код работать быстрее

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 снова.