Поиск нескольких строк в книге Excel - PullRequest
Новая
       26

Поиск нескольких строк в книге Excel

0 голосов
/ 26 апреля 2020

Я пытаюсь создать макрос для поиска нескольких строк в Excel.

У меня есть следующий код, который ищет слово "techno" в Excel, но мне нужно включить переменную в код, так что я могу искать несколько слов, таких как "Techno", "electromagneti c", "waves" и др. c. сразу. Я не могу создать al oop для этого условия.

Может кто-нибудь предложить решение этой проблемы? Приведенный ниже код работает нормально, но для включения нескольких строк в поиск требуется только настройка. 

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

1 Ответ

0 голосов
/ 26 апреля 2020

Если строки, которые вы ищете, всегда будут одинаковыми, жестко закодируйте их в массив и L oop через элементы массива для поиска каждой строки, например: 

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
...