Mencari konten dalam sejumlah besar file Excel

Saya memiliki 2500 file Excel. Saya perlu menampilkan semua baris yang berisi string tertentu di kolom tertentu. Bagaimana saya bisa melakukan ini? Bagaimana jika string tertentu tidak di kolom tetap, tetapi bisa di kolom mana saja?

Ini beberapa kode skelet-O. Anda dapat membangun ini atau orang lain di sini bisa. Potongan besar belum ditulis. Mungkin saya akan melakukan lebih banyak ketika saya pulang.

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

Dari komentar Anda, saya menganggap Anda belum pernah menulis makro VBA. Makro pertama Anda akan menjadi pendakian yang tidak menanjak tetapi setelah itu masing-masing akan lebih mudah sampai Anda lupa Anda pernah berpikir mereka mungkin sulit untuk ditulis.

Makro di bawah ini mengasumsikan bahwa semua 2.500 buku kerja berada di folder yang sama. Ini biasanya merupakan pendekatan yang paling mudah tetapi mungkin tidak mungkin dalam kasus Anda. Jika tidak memungkinkan, pilih folder dengan banyak buku kerja untuk mencoba makro ini. Anda harus menambahkan penjelasan tentang situasi Anda ke pertanyaan Anda sehingga saya dapat menjelaskan bagaimana makro ini dapat disesuaikan untuk mengatasinya.

Saya telah mencoba untuk menjaga hal-hal yang sederhana walaupun mungkin tidak terlihat seperti itu. Ada cara yang lebih baik dan lebih cepat untuk melakukan hal yang sama tetapi saya pikir ini adalah kompromi yang tepat. Saya telah memasukkan banyak komentar yang menjelaskan apa yang dilakukan kode. Bantuan editor makro akan menjelaskan sintaksisnya. Tetapi tanyakan apakah Anda sedang berjuang.

Buat buku kerja baru di folder yang Anda pilih untuk ujian. Kode saya mengharapkan lembar kerja bernama "Bobert" yang nyaman bagi saya. Pilih nama yang masuk akal bagi Anda dan ubah kode yang cocok; Saya katakan caranya nanti.

Pilih Toolskemudian Macrokemudian Visual Basic Editoratau klik Alt+ F11.

Di sebelah kiri Anda akan memiliki Project explorer. Di bagian atas di sebelah kanan Anda akan memiliki area abu-abu. Di bagian bawah di sebelah kanan Anda akan memiliki jendela langsung. Saya dapat berbicara tentang jendela langsung nanti.

Pilih Insertkemudian Module. "Module1" akan ditambahkan ke penjelajah proyek dan area abu-abu menjadi putih. Ini adalah area kode untuk Module1.

Anda dapat meninggalkan nama modul sebagai "Module1" atau Anda dapat mengubahnya. Klik F4. Jendela Properties akan ditampilkan. Satu-satunya properti untuk modul adalah namanya. Klik "Modul 1" di "(Nama) Module1", mundur "Module1" dan ketik nama pilihan Anda. Tutup jendela Properties.

Salin kode di bawah ini ke area kode.

Makro ini menangani bagian pertama dari masalah Anda: ia menemukan semua buku kerja di folder dan semua lembar kerja di dalam buku kerja tersebut. Itu membuat daftar lembar kerja di lembar kerja "Bobert". Jika 2.500 buku kerja tidak dapat disatukan dalam satu folder, Anda mungkin perlu makro seperti ini untuk membuat daftar buku kerja dan lembar kerja yang akan diperiksa tetapi makro ini dimaksudkan sebagai latihan latihan. Buat baris tajuk:

 A1 = Folder
 B1 = Workbook
 C1 = Worksheet

Satu-satunya pernyataan yang perlu Anda ubah segera adalah:

  Set WShtDest = ActiveWorkbook.Worksheets("Bobert")

Ubah "Bobert" ke nama yang Anda pilih untuk lembar kerja di mana daftar lembar kerja akan dibuat.

Tempatkan kursor pada pernyataan:

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

dan klik F9. Garis akan menjadi cokelat karena Anda telah membuatnya menjadi breakpoint yang saya jelaskan sebentar lagi.

Setiap kali Anda mengklik F8, satu pernyataan kode akan dipatuhi. Ini memungkinkan Anda menelusuri kode. Jika Anda meletakkan kursor di atas nama variabel, nilainya akan ditampilkan. Anda bisa beralih ke lembar kerja untuk memeriksa apa yang telah berubah.

Jika Anda pikir Anda memahami blok kode, klik F5 dan kode tersebut akan berjalan hingga breakpoint berikutnya. Saya telah menetapkan satu tetapi Anda dapat mengatur sebanyak yang Anda inginkan.

Saya harap ini memberi Anda sesuatu untuk dipikirkan. Jawab pertanyaan saya dan saya bisa memberikan Anda sedikit solusi selanjutnya.

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