Поиск контента в большом количестве файлов Excel

Question

У меня 2500 файлов Excel. Мне нужно вывести все строки, которые содержат определенную строку в определенном столбце. Как я могу это сделать? Что если определенная строка не находится в фиксированном столбце, но может быть в любом столбце?

Answer 1

Вот немного кода скелетона. Вы можете либо опираться на это, либо кто-то еще здесь может. Большие куски еще предстоит написать. Может быть, я сделаю больше, когда вернусь домой.

Option Explicit

Sub findInFolders()
    Dim folderName As String 'this is where all the files reside, some extra work is neede if there are sub directories
    'folderName = <put your folder name here>
    Dim files() As String: Set files = GetFolderContents
    Dim i As Integer

    Dim wb As Workbook, sht As Worksheet
    For i = LBound(files) To UBound(files)

        Set wb = Application.Workbooks.Open(files(i))
        For Each sht In wb.Sheets
            GetRowsBasedOnString searchString, sht
        Next sht

        wb.Close False
        Set wb = Nothing
    Next i
End Sub


Function GetFolderContents(folderName As String) As String()
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    GetFolderContents = fso.GetFolder(folderName).files
End Function

Function GetRowsBasedOnString(searchString As String, sht As Worksheet)
    'loop through range or use find or whatever. Find the value your looking for
    Dim found As Boolean, rng As Range
    If found Then ReportFoundRow rng
End Function

Function ReportFoundRow(foundRow As Range)
    'write your found data to your master workbook
End Function

Answer 2

Из ваших комментариев я предполагаю, что вы никогда не писали макрос VBA. Ваш первый макрос будет неспешным, но после этого каждый будет легче, пока вы не забудете, что когда-либо думали, что его сложно написать.

В приведенном ниже макросе предполагается, что все 2500 рабочих книг находятся в одной папке. Обычно это самый простой подход, но он может быть невозможен в вашем случае. Если это невозможно, выберите папку с большим количеством книг, чтобы опробовать этот макрос. Вам нужно будет добавить объяснение вашей ситуации к вашему вопросу, чтобы я мог объяснить, как этот макрос можно адаптировать для его решения.

Я пытался сделать вещи простыми, хотя это может показаться не таким. Есть лучшие, более быстрые способы сделать то же самое, но я думаю, что это правильный компромисс. Я включил много комментариев, объясняющих, что делает код. Справка редактора макросов объяснит синтаксис. Но спросите, если вы боретесь.

Создайте новую книгу в папке, которую вы выбрали для теста. Мой код ожидает лист с именем "Боберт", который мне удобен. Выберите имя, которое имеет смысл для вас, и измените код для соответствия; Расскажу как позже.

Выберите Tools затем Macro затем Visual Basic Editor или нажмите Alt+F11 .

Внизу слева у вас будет Project Explorer. Вверху справа у вас будет серая зона. Внизу справа у вас будет окно. Я могу поговорить о ближайшем окне позже.

Выберите Insert затем Module . "Module1" будет добавлен в проводник проекта, а серая область станет белой. Это область кода для Module1.

Вы можете оставить имя модуля как "Module1" или изменить его. Нажмите F4. Откроется окно свойств. Единственным свойством для модуля является его имя. Нажмите "Модуль 1" в «(Имя) Module1», отступите "Module1" и введите имя по вашему выбору. Закройте окно свойств.

Скопируйте приведенный ниже код в область кода.

Этот макрос решает первую часть вашей проблемы: он находит все рабочие книги в папке и все рабочие таблицы в этих рабочих книгах. Он создает список этих листов в листе "Боберт". Если 2500 рабочих книг не могут быть собраны в одну папку, вам может понадобиться такой макрос, чтобы составить список рабочих книг и рабочих таблиц, которые нужно изучить, но этот макрос предназначен для обучения. Создайте строку заголовка:

 A1 = Folder
 B1 = Workbook
 C1 = Worksheet

Единственное утверждение, которое вам нужно будет изменить немедленно:

  Set WShtDest = ActiveWorkbook.Worksheets("Bobert")

Измените "Bobert" на имя, которое вы выбрали для рабочего листа, в котором будет создан список рабочих листов.

Поместите курсор на оператор:

    RowDestCrnt = .Cells(Rows.Count, "A").End(xlUp).Row + 1

и нажмите F9. Линия станет коричневой, потому что вы сделали ее точкой останова, которую я сейчас объясню.

Каждый раз, когда вы нажимаете F8, будет выполнено одно утверждение кода. Это позволяет вам шаг за шагом кода. Если навести курсор на имя переменной, отобразится ее значение. Вы можете переключиться на рабочий лист, чтобы проверить, что изменилось.

Если вы думаете, что понимаете блок кода, нажмите F5, и код будет работать до следующей точки останова. Я установил один, но вы можете установить столько, сколько хотите.

Надеюсь, это даст вам возможность подумать. Ответьте на мои вопросы, и я смогу дать вам следующий ответ.

Option Explicit
' Searching for content in a large number of Excel files
' http://superuser.com/q/452980/108084
Sub ListWorksheets()

  Dim ColDestCrnt As Long
  Dim FileNameList() As String
  Dim InxFNL As Long
  Dim InxW As Long
  Dim PathCrnt As String
  Dim RowDestCrnt As Long
  Dim WBkSource As Workbook
  Dim WShtDest As Worksheet

  Application.ScreenUpdating = False

  ' Create a reference to the worksheet in which data will be stored
  ' Change "Bobert" to your name for the destination worksheet.
  Set WShtDest = ActiveWorkbook.Worksheets("Bobert")

  ' This assumes the source workbooks are in the same folder as the workbook
  ' holding this macro.  You could replace this with a statement like:
  '   PathCrnt = "C:\MyFiles"
  PathCrnt = ActiveWorkbook.Path

  ' GetFileNameList is a subroutine I wrote sometime ago.  It returns an
  ' array of filenames within a specified folder (PathCrnt) that match a
  ' specified format (*.xls).
  Call GetFileNameList(PathCrnt, "*.xls", FileNameList)

  ' Get the next free row in worksheet Bobert.  By calling this routine with
  ' different values for PathCrnt, you could built up a list containing files
  ' from many folders.
  With WShtDest
    RowDestCrnt = .Cells(Rows.Count, "A").End(xlUp).Row + 1
  End With

  For InxFNL = LBound(FileNameList) To UBound(FileNameList)
    If FileNameList(InxFNL) <> ActiveWorkbook.Name Then
      ' In the Workbook Open statement, 0 means "do not update any links" and
      ' True means "open read only"
      Set WBkSource = Workbooks.Open(PathCrnt & "\" & FileNameList(InxFNL), 0, True)
      With WBkSource
        ' Record the name of each worksheet in the workbook
        For InxW = 1 To .Worksheets.Count
          WShtDest.Cells(RowDestCrnt, "A").Value = PathCrnt
          WShtDest.Cells(RowDestCrnt, "B").Value = FileNameList(InxFNL)
          WShtDest.Cells(RowDestCrnt, "C").Value = .Worksheets(InxW).Name
          RowDestCrnt = RowDestCrnt + 1
        Next
        .Close SaveChanges:=False     ' Close this source workbook
      End With
    End If
  Next

End Sub
Sub GetFileNameList(ByVal PathCrnt As String, ByVal FileSpec As String, _
                                            ByRef FileNameList() As String)

' This routine sets FileNameList to the names of files within folder
' PathCrnt that match FileSpec.  It uses function Dir$() to get the file names.
' I can find no documentation that says Dir$() gets file names in alphabetic
' order but I have not seen a different sequence in recent years.

  Dim AttCrnt As Long
  Dim FileNameCrnt As String
  Dim InxFNLCrnt As Long

  ' I initialise the array with space for 100 files and then enlarge it if
  ' necessary.  This is normally enough space for  my applications but since
  ' you are expecting 2,500 files I have replaced the original statement.
  'ReDim FileNameList(1 To 100)
  ReDim FileNameList(1 To 2500)
  InxFNLCrnt = 0

  ' Ensure path name ends in a "\"
  If Right(PathCrnt, 1) <> "\" Then
    PathCrnt = PathCrnt & "\"
  End If

  ' This Dir$ returns the name of the first file in
  ' folder PathCrnt that matches FileSpec.
  FileNameCrnt = Dir$(PathCrnt & FileSpec)
  Do While FileNameCrnt <> ""
    ' "Files" have attributes, for example: normal, to-be-archived, system,
    ' hidden, directory and label. It is unlikely that any directory will
    ' have an extension of XLS but it is not forbidden.  More importantly,
    ' if the files have more than one extension so you have to use "*.*"
    ' instead of *.xls", Dir$ will return the names of directories. Labels
    ' can only appear in route directories and I have not bothered to test
    ' for them
    AttCrnt = GetAttr(PathCrnt & FileNameCrnt)
    If (AttCrnt And vbDirectory) <> 0 Then
      ' This "file" is a directory.  Ignore
    Else
      ' This "file" is a file
      InxFNLCrnt = InxFNLCrnt + 1
      If InxFNLCrnt > UBound(FileNameList) Then
        ' There is a lot of system activity behind "Redim Preserve".  I reduce
        ' the number of Redim Preserves by adding new entries in chunks and
        ' using InxFNLCrnt to identify the next free entry.
        ReDim Preserve FileNameList(1 To 100 + UBound(FileNameList))
      End If
      FileNameList(InxFNLCrnt) = FileNameCrnt
    End If
    ' This Dir$ returns the name of the next file that matches
    ' the criteria specified in the initial call.
    FileNameCrnt = Dir$
  Loop

  ' Discard the unused entries
  ReDim Preserve FileNameList(1 To InxFNLCrnt)

End Sub