数据导入

admin

1. Sub TEST()
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     MyPath = ThisWorkbook.Path & "\基础数据"
   $ ^4 y8 ?( o3 R$ c- x5 r" c
5.     MyName = Dir(MyPath & "*.xlsx")
   8 {: ^" M5 f3 X. q
6.     Do While MyName <> ""
   
7.         If MyName <> ThisWorkbook.Name Then
   ) Z+ d" I; ?5 ?" y( L: s" e8 f: q
8.             Set wb = GetObject(MyPath & MyName)
   $ D" h" P2 {: ^: j; N1 b+ O
9.             For Each sh In Sheets
   
10.                 If sh.Name = Split(MyName, ".")(0) Then wb.Sheets(1).Cells.Copy sh.[a1]
    1 ]( J9 g$ Q) C
11.             Next
    % D! @! f4 Q8 V1 ^6 J9 t* w
12.             wb.Close False
    
13.         End If
    2 U' @% n2 \7 c9 c2 M
14.         MyName = Dir
    . Z) \5 {3 B9 d! n
15.     Loop
    2 Q9 {! y  r% f+ V$ r# l2 u# j
16.     Application.ScreenUpdating = True
    + d/ d3 p, Q! k' y5 R- y
17.     MsgBox "文件夹内所有数据已导入！"
    
18. End Sub

复制代码

& m- k$ d/ E8 I
3 z# X* \* D1 h. V 数据导入.zip (249.58 KB, 下载次数: 91)

2020-4-6 22:33 上传

点击文件名下载附件