循环不在目录之间工作

我使用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) (这只是一个口味问题)