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?
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?
Jawaban:
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 Tools
kemudian Macro
kemudian Visual Basic Editor
atau 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 Insert
kemudian 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
Dir
fungsi ini adalah salah satu fungsi paling membingungkan di VBA. Memanggil melakukan hal yang berbeda tergantung di mana Anda memanggilnya dan panggilan sebelumnya. Sangat sulit untuk diikuti bagi seseorang yang memulai. Saya bersandar pada FileSystemObject
banyak karena memiliki dukungan pengetikan yang kuat untuk folder / file objek dan ada banyak metode / parameter yang ditetapkan di tips finder Anda.
Preserve
Redim dan membuat array Anda dihapus (konsep aneh lain untuk pemula), dan mereka lebih mudah untuk mencari / mengulang.
FileSystemObject
fungsi dan koleksi lebih sulit untuk dipahami daripada fungsi yang lebih lama seperti Dir
dan array. Saya percaya ini karena sulit untuk menemukan penjelasan FileSystemObject
dan koleksi yang bagus. Jika Anda dapat memberikan penjelasan seperti itu, itu akan memberi Bobert kesempatan untuk memahami dan memilih dari berbagai teknik.