Question

当我循环遍历目录以查找特定文件夹中的文件与我的主文件的单元格/行之间的匹配项，并将这些匹配的行复制到我的主文件时，如果没有匹配项，则会收到错误91通知主文件和我正在循环的文件夹中的文件之间。

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

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

Answer 1

在if匹配条件之后使用此条件（它将在匹配条件之后执行，但将其保持在循环中）

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

其中index是您在当前文件中扫描的行/列的索引，而lastindex是当前文件的lastindex（因此是当前文件的结尾）。

但是，这将要求您知道您扫描的文件的lastindex。但您可以使用do while循环轻松完成此操作：

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

以上循环适用于行，但您可以轻松地将其用于列。希望这有帮助！

Answer 2

更改我的宏的以下部分解决了这个问题：

Next CurrentShtRowRef
             If Not CopyRange Is Nothing Then
              CopyRange.Select

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

Excel循环遍历目录继续搜索而不匹配

2 个答案: