У меня 2500 файлов Excel. Мне нужно вывести все строки, которые содержат определенную строку в определенном столбце. Как я могу это сделать? Что если определенная строка не находится в фиксированном столбце, но может быть в любом столбце?
2 ответа
Вот немного кода скелетона. Вы можете либо опираться на это, либо кто-то еще здесь может. Большие куски еще предстоит написать. Может быть, я сделаю больше, когда вернусь домой.
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
Из ваших комментариев я предполагаю, что вы никогда не писали макрос 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