在两个文件夹和匹配的文件之间循环操作

Question

我基本上是VBA的初学者，现在我陷入了困境。我不知道如何使这个过程自动化：我有两个不同的文件夹，文件数量相同。文件名几乎相同(它们像3个字母一样变化，但它们有一个数字计数，例如folder_a中的AAA_Test18和folder_B中的BBB_Test18(我需要修改(在folder_a中相应文件的folder_b中的文件中添加一个选项卡(folder_b中与folder_a的文件编号匹配的所有文件。我已经有了在一个文件上完成所需一切的代码，但关键是我必须打开每个文件，从用户那里获得测试编号，并对每个测试编号重复它。你知道怎么循环吗？

这是代码

Sub NoLoop()
Dim oFoglio As Worksheet
Dim i As Integer
Dim Count As Integer
Dim Tcount As Integer
Dim FileName As String
Dim wkb As Workbook
Dim iVal As Integer
Dim FN As String
Dim NewPath As String
Dim strFileName As String
Dim FileName2 As String
Dim FNumber As String
strFileName = Dir("C:Usersuser1DesktopFolderCOMPARE*1.xlsx")

Do While Len(strFileName) > 0
Set oFoglio = ActiveWorkbook.Worksheets.Add
oFoglio.Name = "COMPARE2"

Set wkb = ActiveWorkbook
Application.ScreenUpdating = False

Set closedBook = Workbooks.Open("C:Usersuser1DesktopFolderDPPEsempio_DPP_Report_v" & FNumber & ".xlsx")
closedBook.Sheets("DPP").Copy Before:=wkb.Sheets(1)
closedBook.Close savechanges:=False

Application.ScreenUpdating = True

Count = Application.WorksheetFunction.CountA(Sheets("DPP").Range("C:C")) + 1
Columns("J").Delete
For i = 3 To Count
Sheets("COMPARE").Cells(i, 1).Value = Sheets("DPP").Cells(i, 7).Value & Sheets("DPP").Cells(i, 8).Value & Sheets("DPP").Cells(i, 9).Value & Sheets("DPP").Cells(i, 10).Value
Sheets("COMPARE").Cells(i, 2).Value = Sheets("CQ").Cells(i, 7).Value & Sheets("CQ").Cells(i, 8).Value & Sheets("CQ").Cells(i, 9).Value & Sheets("CQ").Cells(i, 10).Value
Sheets("COMPARE").Cells(i, 3).FormulaR1C1 = _
"=IF(OR(ISNUMBER(FIND(""A"",RC[-2])),ISNUMBER(FIND(""A"",RC[-1]))),""NA"",IF(EXACT(RC[-2],RC[-1]),(IF(ISNUMBER(FIND(""C"",RC[-2])),""TP"",""TN"")),(IF(ISNUMBER(FIND(""C"",RC[-2])),""FP"",""FN""))))"
Sheets("COMPARE").Cells(i, 4).Value = Sheets("DPP").Cells(i, 11).Value & Sheets("DPP").Cells(i, 12).Value & Sheets("DPP").Cells(i, 13).Value & Sheets("DPP").Cells(i, 14).Value
Sheets("COMPARE").Cells(i, 5).Value = Sheets("CQ").Cells(i, 11).Value & Sheets("CQ").Cells(i, 12).Value & Sheets("CQ").Cells(i, 13).Value & Sheets("CQ").Cells(i, 14).Value
Sheets("COMPARE").Cells(i, 6).FormulaR1C1 = _
"=IF(OR(ISNUMBER(FIND(""A"",RC[-2])),ISNUMBER(FIND(""A"",RC[-1]))),""NA"",IF(EXACT(RC[-2],RC[-1]),(IF(ISNUMBER(FIND(""C"",RC[-2])),""TP"",""TN"")),(IF(ISNUMBER(FIND(""C"",RC[-2])),""FP"",""FN""))))"
Sheets("COMPARE").Cells(i, 7).Value = Sheets("DPP").Cells(i, 15).Value & Sheets("DPP").Cells(i, 16).Value
Sheets("COMPARE").Cells(i, 8).Value = Sheets("CQ").Cells(i, 15).Value & Sheets("CQ").Cells(i, 16).Value
Sheets("COMPARE").Cells(i, 9).FormulaR1C1 = _
"=IF(OR(ISNUMBER(FIND(""A"",RC[-2])),ISNUMBER(FIND(""A"",RC[-1]))),""NA"",IF(EXACT(RC[-2],RC[-1]),(IF(ISNUMBER(FIND(""C"",RC[-2])),""TP"",""TN"")),(IF(ISNUMBER(FIND(""C"",RC[-2])),""FP"",""FN""))))"
Sheets("COMPARE").Cells(i, 11).Value = Sheets("DPP").Cells(i, 2).Value
Sheets("COMPARE").Cells(i, 12).Value = Sheets("CQ").Cells(i, 2).Value
Sheets("COMPARE").Cells(i, 13).FormulaR1C1 = _
"=EXACT(RC[-2],RC[-1])"
Next i
'Bunch of other stuff to do by the code    

strFileName = Dir() 'moves on to check the next file
Loop
End Sub

它工作，但只适用于文件夹的第一个。。。

非常感谢

Answer 1

为了将来的参考，你应该发布你已经尝试过的代码，这样人们就可以指出你需要改进的地方。

根据你的问题，这里有一些提示可能会有所帮助：

您可能已经在使用Dir函数，它是查找文件和文件夹所需要的。

• 请参阅此处以获取有关它的microsoft文档
• 它可以使用允许变化的通配符进行调用；例如函数。Dir(C:FolderPathMyFolder*.xlsx)将返回Myfolder中第一个文件的文件名，文件扩展名为.xlsx，因为*通配符允许文件夹路径和该文件扩展名之间的任何字符
  在您的情况下，您可能会使用它来查找以某个测试编号或其他内容结尾的任何文件(之后不要忘记文件扩展名！(
• 在没有参数的情况下再次调用Dir函数(只有Dir()(，会在同一文件夹中找到与原始条件匹配的下一个文件名。这就是在文件夹中循环使用文件名的方法

您还需要一个Do While或Do Until循环-只需在谷歌上搜索"do until Loop vba"，您就会发现大量关于如何将其组合在一起的教程。

粗略示例：

Sub LoopThroughFiles()
Dim strFileName as String
strFileName = Dir("C:UsersMeDocumentsMyFolder*1.txt")
'That's looking for a text file in MyFolder with a name ending in 1
'The dir function returns an empty string if it doesn't find anything

Do While Len(strFileName) > 0 'Checking it hasn't returned an empty string
'-------
Debug.print strFileName
'Do stuff to the file in this bit!
'-------
strFileName = Dir() 'moves on to check the next file
Loop

Msgbox "All files checked. :)", vbOkOnly + vbInformation
End Sub