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循環瀏覽目錄繼續搜索不匹配

回答

相關問題