循环不在目录之间工作
我使用vba代码来search工作簿列中的单元格列表,并且需要在文件夹中search这些单元格,并且如果单元格在任何工作簿中都匹配,则需要将所有相应的数据复制到主工作簿。
我正在使用2个循环,但如果一个正在工作另一个不是例如,如果我循环通过文件夹中的所有文件,我不能循环与主工作簿中的列来search一个接一个的单元格。
以下是代码:
Sub SearchFolders() Dim fso As Object Dim fld As Object Dim strSearch As String Dim strPath As String Dim strFile As String Dim wOut As Worksheet Dim wbk As Workbook Dim wks As Worksheet Dim rFound As Range Dim irow As Integer Dim rng As Range Dim strFirstAddress As String On Error GoTo ErrHandler Application.ScreenUpdating = False strPath = "\dfs\Home\Tes" Set wOut = ThisWorkbook.Worksheets("Data") With wOut lRow = 2 Set fso = CreateObject("Scripting.FileSystemObject") Set fld = fso.GetFolder(strPath) strFile = Dir(strPath & "\*.xls*") Do While Cells(lRow, 1) < Empty strSearch = Cells(lRow, 1) Set wbk = Workbooks.Open _ (Filename:=strPath & "\" & strFile, _ UpdateLinks:=0, _ ReadOnly:=True, _ AddToMRU:=False) For Each wks In wbk.Worksheets Set rFound = wks.UsedRange.Find(strSearch) If Not rFound Is Nothing Then strFirstAddress = rFound.Address End If Do If rFound Is Nothing Then Exit Do Else Cells(lRow, 2) = rFound.Offset(0, 1).Value Cells(lRow, 3) = rFound.Offset(0, 2).Value End If Set rFound = wks.Cells.FindNext(After:=rFound) Loop While strFirstAddress < rFound.Address Next wbk.Close (False) lRow = lRow + 1 Loop End With MsgBox "Done" End Sub
我认为你必须改变这种做法
Do While .Cells(lRow, 1) <> Empty
说明:如果使用Cells(lRow, 1)
(无圆点),则可以访问活动工作表。 但是在你做一个workbook.open
的那一刻,活动workbook.open
表会改变,所以在下一次迭代时,你不再查看工作表,而是查看打开的工作簿的表格。
如果你写了.Cells(lRow, 1)
(带有前导点), Cells
被看作是你在with
With wOut
使用的任何属性,在你的情况下With wOut
。 或者,你可以写wOut.Cells(lRow, 1)
(这只是一个口味问题)