在 Excel 工作簿中搜索多个字符串

Question

我正在尝试设计一个宏来在 excel 中搜索多个字符串。

我有以下代码在 Excel 中搜索单词“techno”，但我需要在代码中包含一个变量，以便可以搜索多个单词，例如“Techno”、“electromagnetic”、“waves”等。我无法为这种情况创建循环。

任何人都可以提出解决此问题的方法吗？下面的代码可以正常工作，但只需要稍作调整即可在搜索中包含多个字符串。

Sub SearchFolders()
    Dim xFso As Object
    Dim xFld As Object
    Dim xStrSearch As String
    Dim xStrPath As String
    Dim xStrFile As String
    Dim xOut As Worksheet
    Dim xWb As Workbook
    Dim xWk As Worksheet
    Dim xRow As Long
    Dim xFound As Range
    Dim xStrAddress As String
    Dim xFileDialog As FileDialog
    Dim xUpdate As Boolean
    Dim xCount As Long

    myArray = Array("techno", "magnetic", "laser", "trent") 
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a forlder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set xOut = Worksheets.Add
    For myCounter = 0 To UBound(myArray)         
        MsgBox myCounter & " is the Count No."   
        xStrSearch = myArray(myCounter)          
        MsgBox xStrSearch & " is the Value fr String search" 
        xRow = 1
        With xOut
            .Cells(xRow, 1) = "Workbook"
            .Cells(xRow, 2) = "Worksheet"
            .Cells(xRow, 3) = "Cell"
            .Cells(xRow, 4) = "Text in Cell"
            Set xFso = CreateObject("Scripting.FileSystemObject")
            Set xFld = xFso.GetFolder(xStrPath)
            xStrFile = Dir(xStrPath & "*.xls*")
            Do While xStrFile <> ""
                Set xWb = Workbooks.Open(Filename:=xStrPath & "\" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
                For Each xWk In xWb.Worksheets
                    Set xFound = xWk.UsedRange.Find(xStrSearch)
                    MsgBox xFound & " is the strings found"
                    If Not xFound Is Nothing Then
                        xStrAddress = xFound.Address
                    End If
                    Do
                        If xFound Is Nothing Then
                            Exit Do
                        Else
                            xCount = xCount + 1
                            MsgBox xCount & " is the count of strings"
                            xRow = xRow + 1
                            .Cells(xRow, 1) = xWb.Name
                            .Cells(xRow, 2) = xWk.Name
                            .Cells(xRow, 3) = xFound.Address
                            .Cells(xRow, 4) = xFound.Value
                        End If
                        Set xFound = xWk.Cells.FindNext(After:=xFound)
                        MsgBox xFound & " next string" 
                        MsgBox xStrAddress & " is the address " 
                        MsgBox xFound.Address & " is the address found"
                    Loop While xStrAddress <> xFound.Address 'To check how xStrAddress is populated or do we need to declare it as a help from excel pointed out
                    myCounter = myCounter + 1
                Next
                xWb.Close (False)
                xStrFile = Dir
            Loop
            .Columns("A:D").EntireColumn.AutoFit
        End With
    Next myCounter                           
    MsgBox xCount & "cells have been found", , 
    ExitHandler:
    Set xOut = Nothing
    Set xWk = Nothing
    Set xWb = Nothing
    Set xFld = Nothing
    Set xFso = Nothing
    Application.ScreenUpdating = xUpdate
    Exit Sub
    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Answer 1

如果您要搜索的字符串总是相同的，请将它们硬编码到一个数组中并循环遍历数组元素以搜索每个字符串，如下所示：

Dim myArray as Variant
Dim myCounter as Long

myArray = Array("techno", "electromagnetic", ...etc.)

For myCounter = 0 To UBound(myArray)
    ... 'your code here
   xStrSearch = myArray(myCounter)
    ... 'the rest if your code here
Next myCounter