按文件名称复制到指定表格里

用户名用什么好

ykcbf1100 发表于 2023-4-26 20:21
a = [{"214","SA","888","999"}]
b = [{"214","216","AAA","BBB"}]

谢谢老师，再请教下哈

比如有几十个文件......可不指定文件名，做匹配导入要怎么写？

Peny2020

用户名用什么好 发表于 2023-4-27 09:14
谢谢老师，再请教下哈

比如有几十个文件......可不指定文件名，做匹配导入要怎么写？

不指定，你用什么来条件来导入？

ykcbf1100

用户名用什么好 发表于 2023-4-27 09:14
谢谢老师，再请教下哈

比如有几十个文件......可不指定文件名，做匹配导入要怎么写？

你别问来问去了，直接上附件吧。

用户名用什么好

ykcbf1100 发表于 2023-4-27 09:58
你别问来问去了，直接上附件吧。

Sub ykcbf()         '//2023.4.21
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim arr, brr, d, p, f
    Set d = CreateObject("Scripting.Dictionary")
    Dim tm: tm = Timer
    a = [{"214","SA"}]
    b = [{"214","216"}]
    For i = 1 To 2
        d(a(i)) = b(i)
    Next
    Set zwb = ThisWorkbook
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls*")
    Do While f <> ""
        For Each k In d.keys
            If InStr(f, k) Then
                With Workbooks.Open(p & f, 0)
                    arr = .Sheets(1).UsedRange
                    .Close False
                End With
                zwb.Sheets(d(k)).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
                Exit For
            End If
        Next
        f = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "运行完毕，共用时： " & Format(Timer - tm, "0.000秒"), , "提示"
End Sub


请教下老师，您的附件代码，如实现从文件的B5开始复制，或复制B5:E100，该怎么处理？谢谢

用户名用什么好

ykcbf1100 发表于 2023-4-21 16:14
参与一下。

谢谢老师，我上传的附件总是审核不过去。

再请教您一下
1、我把a1改成b5，即要从b5开始粘贴，但总是报错
zwb.Sheets(d(k)).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr

2、或如原文件从B5开始开始复制，应怎么写？

谢谢！

Sub ykcbf()         '//2023.4.21
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim arr, brr, d, p, f
    Set d = CreateObject("Scripting.Dictionary")
    Dim tm: tm = Timer
    a = [{"214","SA"}]
    b = [{"214","216"}]
    For i = 1 To 2
        d(a(i)) = b(i)
    Next
    Set zwb = ThisWorkbook
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls*")
    Do While f <> ""
        For Each k In d.keys
            If InStr(f, k) Then
                With Workbooks.Open(p & f, 0)
                    arr = .Sheets(1).UsedRange
                    .Close False
                End With
                zwb.Sheets(d(k)).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
                Exit For
            End If
        Next
        f = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "运行完毕，共用时： " & Format(Timer - tm, "0.000秒"), , "提示"
End Sub

用户名用什么好

ykcbf1100 发表于 2023-4-21 16:14
参与一下。

不好意思，再请教下老师，如改成自主选择目录，该如何改？
即附件中，带宏的文件与其他文件不同个目录
运行宏时，自主选择放214、SA文件的文件夹

谢谢，谢谢！

Sub ykcbf()         '//2023.4.21
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim arr, brr, d, p, f
    Set d = CreateObject("Scripting.Dictionary")
    Dim tm: tm = Timer
    a = [{"214","SA"}]
    b = [{"214","216"}]
    For i = 1 To 2
        d(a(i)) = b(i)
    Next
    Set zwb = ThisWorkbook
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls*")
    Do While f <> ""
        For Each k In d.keys
            If InStr(f, k) Then
                With Workbooks.Open(p & f, 0)
                    arr = .Sheets(1).UsedRange
                    .Close False
                End With
                zwb.Sheets(d(k)).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
                Exit For
            End If
        Next
        f = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "运行完毕，共用时： " & Format(Timer - tm, "0.000秒"), , "提示"
End Sub