Excel循环浏览目录继续搜索不匹配

当我通过目录循环查找特定文件夹中的文件与单元格/行之间的匹配，并将这些匹配的行复制到我的主文件中时，我得到一个错误91通知如果主文件和我正在循环的文件夹中的文件之间没有匹配。Excel循环浏览目录继续搜索不匹配

如果一个特定的文件没有匹配，我希望我的宏自动查看下一个文件等，而不显然给我这个错误。任何建议如何解决这个问题？

Option Explicit 

Sub CopyToMasterFile() 

    Dim MasterWB As Workbook 
    Dim MasterSht As Worksheet 
    Dim MasterWBShtLstRw As Long 
    Dim FolderPath As String 
    Dim TempFile 
    Dim CurrentWB As Workbook 
    Dim CurrentWBSht As Worksheet 
    Dim CurrentShtLstRw As Long 
    Dim CurrentShtRowRef As Long 
    Dim CopyRange As Range 
    Dim ProjectNumber As String 
    Dim wbname As String 
    Dim sheetname As String 

    wbname = ActiveWorkbook.Name 
    sheetname = ActiveSheet.Name 

    FolderPath = "C:\data\" 
    TempFile = Dir(FolderPath) 

    Dim WkBk As Workbook 
    Dim WkBkIsOpen As Boolean 

    For Each WkBk In Workbooks 
     If WkBk.Name = wbname Then WkBkIsOpen = True 
    Next WkBk 

    If WkBkIsOpen Then 
     Set MasterWB = Workbooks(wbname) 
     Set MasterSht = MasterWB.Sheets(sheetname) 
    Else 
     Set MasterWB = Workbooks.Open(FolderPath & wbname) 
     Set MasterSht = MasterWB.Sheets(sheetname) 
    End If 

    ProjectNumber = MasterSht.Cells(1, 1).Value 



    Do While Len(TempFile) > 0 


     If Not TempFile = wbname And InStr(1, TempFile, "xlsx", vbTextCompare) Then 

      Set CopyRange = Nothing 

      With MasterSht 
       MasterWBShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row 
      End With 

      Set CurrentWB = Workbooks.Open(FolderPath & TempFile) 
      Set CurrentWBSht = CurrentWB.Sheets(1) 

      With CurrentWBSht 
       CurrentShtLstRw = .Cells(.Rows.Count, "AD").End(xlUp).Row 
      End With 

      For CurrentShtRowRef = 1 To CurrentShtLstRw 

      If CurrentWBSht.Cells(CurrentShtRowRef, "AD").Value = ProjectNumber Then 


      If CopyRange Is Nothing Then 
       set CopyRange = CurrentWBSht.Range("AE" & CurrentShtRowRef & _ 
               ":AQ" & CurrentShtRowRef) 
       Else 
       Set CopyRange = Union(CopyRange, _ 
             CurrentWBSht.Range("AE" & CurrentShtRowRef & _ 
                  ":AQ" & CurrentShtRowRef)) 
       End If 
      End If 

      Next CurrentShtRowRef 

      CopyRange.Select 


      CopyRange.Copy 
      MasterSht.Cells(MasterWBShtLstRw + 1, 1).PasteSpecial xlPasteValues 

      Application.DisplayAlerts = False 
      CurrentWB.Close savechanges:=False 
      Application.DisplayAlerts = True 

     End If  

     TempFile = Dir 

    Loop 

ActiveSheet.Range("A1:M200").RemoveDuplicates Columns:=Array(1, 2, 4, 8, 9, 10, 11, 12), Header:=xlYes 

End Sub

来源

2017-08-08 Smits

对于任何人看你的问题，我们需要看看代码。请提供代码 – Zac

使用您的if匹配条件（将匹配条件后执行，但将其保留在循环）

if index = lastindex then 'if you have reached the end of the current file 
'proceed to next file

哪里index是行的索引后，这种情况下/列你正在扫描当前文件，并且lastindex是当前文件的lastindex（因此是当前文件的结尾）。

然而这会要求您知道您扫描的文件的最后索引。但是你可以很容易地用dowhile循环做到这一点：

index= 1 
    Do While (Not IsEmpty(Sheets("YourSheetName").Cells(index, 1))) 
     index= index+ 1 

    Loop 
    index= index- 1 'remove last cell corresponding to first empty cell

这上面的循环适用于行，但您可以轻松地使用它的列。希望这有助于！

来源

2017-08-08 09:16:30 Diveye

感谢您的回复，找出我的marco的具体问题并不难，而且完全不同。不过，谢谢你的建议。 – Smits

改变我的宏下面的部分解决了这个问题：

Next CurrentShtRowRef 
      If Not CopyRange Is Nothing Then 
       CopyRange.Select 

       CopyRange.Copy 
       MasterSht.Cells(MasterWBShtLstRw + 1, 1).PasteSpecial xlPasteValues 
      End If

来源

2017-08-08 13:04:07 Smits

Excel循环浏览目录继续搜索不匹配

回答

相关问题