Vba Excel在目录中循环继续搜索,不匹配项

Vba Excel在目录中循环继续搜索,不匹配项,vba,excel,Vba,Excel,当我在目录中循环查找特定文件夹中的文件与主文件的单元格/行之一之间的匹配,并将这些匹配的行复制到主文件时,如果主文件与我循环的文件夹中的文件之间不匹配,我会收到错误91通知 如果一个特定的文件没有匹配项,我希望我的宏自动查看下一个文件,依此类推,而不给我这个明显的错误。有什么建议可以解决这个问题吗 Option Explicit Sub CopyToMasterFile() Dim MasterWB As Workbook Dim MasterSht As Worksheet

当我在目录中循环查找特定文件夹中的文件与主文件的单元格/行之一之间的匹配,并将这些匹配的行复制到主文件时,如果主文件与我循环的文件夹中的文件之间不匹配,我会收到错误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

在if匹配条件之后使用此条件。它将在匹配条件之后执行,但请将其保留在循环中

if index = lastindex then 'if you have reached the end of the current file
'proceed to next file
其中index是当前文件中正在扫描的行/列的索引,lastindex是当前文件的lastindex,因此是当前文件的结尾

但是,这需要您知道扫描文件的最新索引。但您可以通过do while循环轻松完成此任务:

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

更改宏的以下部分解决了此问题:

Next CurrentShtRowRef
             If Not CopyRange Is Nothing Then
              CopyRange.Select

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

对于任何人看你的问题,我们需要看一下代码。请提供代码谢谢你的回复,为我的马可找出了具体的问题并不是太难,也没有太大的不同。不过,谢谢你的建议。
Next CurrentShtRowRef
             If Not CopyRange Is Nothing Then
              CopyRange.Select

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