Question

我在两个不同目录中有一组文件，它们类似于目录A中的每个文件，目录B中有一个文件，它在前缀（主题ID）中共享相同的前四个字符。例如，

目录A包含文件： 001FileNameX， 002FileNameX， 003FileNameX，等

和目录B包含文件： 001FileNameY， 002FileNameY， 003FileNameY，等

我想要创建的是一个宏循环：

搜索两个目录，直到找到一组共享相同前四个字符的文件名（例如，将目录A中的001FileNameX与目录B中的001FileNameY匹配）
如果找到匹配的集合，我希望它执行一段代码。在这种情况下，我希望它将一系列单元格从目录A中的文件（工作簿）复制并粘贴到目录B中的文件（不同的工作簿），然后关闭工作簿（将更改保存到目录B中的工作簿）。
然后返回目录并找到下一组匹配的文件名，依此类推，直到没有剩余的匹配项。

我通常能够使用通配符来搜索类似的文件，但这种情况因特殊性增加而不同 - 我需要使用前缀中的前四个字符将两个不同目录中的文件名发送到MATCH然后循环，同时允许四个字符的下一个前缀与最后一个前缀不同。有没有人对如何解决这个问题有任何想法？

以下是我通常在前缀无关紧要或不更改时使用的代码示例，我复制/粘贴的工作簿也是静态的。非常感谢您的帮助！

Sub Insert_Template_With_Formulas（）

Dim FNames As String
Dim DirectoryA As String    

DirectoryA = Cells(2, 2).Value

ChDrive DirectoryA
ChDir DirectoryA

' Open any file containing "Resps.xlsx", regardless of prefix

 FNames = Dir("*Resps.xlsx")
    If Len(FNames) = 0 Then
        MsgBox "No files in the Directory"
        Exit Sub
    End If

Application.ScreenUpdating = False


Do While FNames <> ""


        Workbooks.Open ("Resps_Template.xlsx")
            Range("AL1:BX32").Select
            Selection.Copy


        Workbooks.Open (FNames)
            Range("AL1").Select
            ActiveSheet.Paste


    ActiveWorkbook.Save
    ActiveWorkbook.Close


    Workbooks("Resps_Template.xlsx").Close SaveChanges:=False


    ChDrive DirectoryA
    ChDir DirectoryA

    ' Call Dir again without arguments to return the next file in the same 
      directory

     FNames = Dir()

Loop

Application.ScreenUpdating = True

End Sub

Answer 1

通过循环获取目录A中所有文件名（无路径）的数组列表：
Dir("FullPAth\Directory A\", vbNormal) Dir w / o参数。{ 然后迭代此数组并检查类似命令的非零结果：
Dir("FullPAth\Directory B\" & sArr(i), vbNormal)。

如果两个单独的目录中的两个文件名匹配，那么

1 个答案: