VBA实现夸文件夹判断文件名前6位是否相同，如果想通则复制固定列数据

rkrkrk123

各位大神，有个疑问困扰好久一直没有解决，期盼大佬指点；
有两个文件夹A，B，分别有多个excel文件，现在需要实现：
对A中的每个文件，在B文件夹中进行查找匹配，判断两个文件名的前6位是否相同，
如果相同，则复制B文件夹中文件的E-F列数据复制到A文件夹中的文件，如果没有则查找下一个；

例如，附件中，A、B文件夹中都有名L11111，L22222开头的文件，
则需要自动将B文件夹中文件名以L11111，L22222开头的文件的E-F列数据复制到A文件夹中同样开头的文件中；


感谢各位老师帮助，谢谢。

psxk3535

因为没有示例数据，不知具体要求，也不知能不能符合。运行速度可能不是很快，希望有老师写成好代码供我们学习

liulang0808

Sub dlkfjdl()
    Set d = CreateObject("scripting.dictionary")
    Set fso = CreateObject("scripting.filesystemobject")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = True
    For Each f In fso.getfolder(ThisWorkbook.Path & "\b").Files
        If Len(f.Name) >= 6 Then
            d(Left(f.Name, 6)) = d(Left(f.Name, 6)) & "@@@" & f
        End If
    Next
    For Each f In fso.getfolder(ThisWorkbook.Path & "\a").Files
        If Len(f.Name) >= 6 Then
            If d.exists(Left(f.Name, 6)) Then
                str1 = d(Left(f.Name, 6))
                brr = Split(d(Left(f.Name, 6)), "@@@")
                Set wa = Workbooks.Open(f)
                For i = 1 To UBound(brr)
                    With Workbooks.Open(brr(i))
                        .Sheets(1).Columns("e:f").Copy wa.Worksheets(1).[e1]
                    End With
                    .Close False
                Next i
                wa.Save
                wa.Close True
            End If
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

liulang0808

供参考。。。。。。

rkrkrk123

liulang0808 发表于 2021-12-6 13:21
供参考。。。。。。

感谢大佬，已经好了