如何快速搜索多个电子表格Excel VBA？

Question

我正在尝试搜索多个工作簿以查找多个搜索字词，并将搜索结果放在电子表格中。到目前为止，我已编写代码来遍历5个工作簿并查找一个搜索词。但是，我的代码运行需要5分钟，这还不够快，因为我需要能够在几百个工作簿上查找10个搜索项。我认为迭代工作簿需要很长时间，而For Each循环耗时太长。如何更快地制作此代码？

Sub SearchTerms()
Dim folderPath As String
Dim filename As String
Dim wb As Workbook
Dim n As Long
Dim cell As Range
Dim curr As Range
Dim found As Boolean
Dim foundTerm As Boolean
Dim myArray As Variant

folderPath = 'path name goes here

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xls")
Do While filename <> ""
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
    Set wb = Workbooks.Open(folderPath & filename)
    On Error GoTo 0

    For i = 1 To 10
        If Not IsEmpty(Cells(i, "D")) Then
            Exit For
        End If
    Next

    found = False
    n = Workbooks("jan17 search terms").Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Row
    For Each curr In Range("A" & i, "Z" & i)
        If InStr(1, curr.Value, "Protein", vbTextCompare) > 0 Or InStr(1, curr.Value, "Phosphosite", vbTextCompare) > 0 Or InStr(1, curr.Value, "Accession", vbTextCompare) > 0 Or InStr(1, curr.Value, "Uniprot", vbTextCompare) > 0 Then
            For Each cell In ActiveWorkbook.ActiveSheet.UsedRange
                If InStr(1, cell.Value, "search term", vbTextCompare) > 0 Then
                    Workbooks("jan17 search terms").Sheets("Sheet1").Cells(n, 2).Value = "Yes"
                        foundTerm = True
                        Exit For
                End If
            Next
            Exit For
        End If
    Next

    If Not foundTerm Then Workbooks("jan17 search terms").Sheets("Sheet1").Cells(n, 2).Value = "-"

    'prints filename on the side
    n = Workbooks("jan17 search terms").Sheets("Sheet1").UsedRange.Rows(Workbooks("jan17 search terms").Sheets("Sheet1").UsedRange.Rows.Count).Row
    Workbooks("jan17 search terms").Worksheets("Sheet1").Cells(n, 1).Value = filename

    wb.Close
    filename = Dir
Loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub