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