请教如何将数据包的所有文件内容按照内容明细表一行一行的放入

jsnj_wjq82

请教如何将数据包的所有文件部分内容按照内容明细表一行一行的放入

grf1973

1. Sub 导入文件()
   
2.     Application.DisplayAlerts = False
   
3.     Dim Filename, wb As Workbook, Sht As Worksheet
   
4.     Set Sht = ActiveSheet
   
5.     Filename = Dir(ThisWorkbook.Path & "\*.xls")
   
6.     r = Sht.[a65536].End(3).Row
   
7.     Do While Filename <> ""
   
8.         If Filename <> ThisWorkbook.Name Then
   
9.             fn = ThisWorkbook.Path & "" & Filename
   
10.             Set wb = Workbooks.Open(fn)
    
11.             With wb.Worksheets(1)
    
12.                 r = r + 1
    
13.                 Sht.Cells(r, 1).Resize(1, 5) = Array(.[b2], .[c3], .[f3], .[c73], .[c86])
    
14.                 Set xrng = .[a:a].Find("指导", lookat:=xlWhole)
    
15.                 If Not xrng Is Nothing Then Sht.Cells(r, 6) = xrng.Offset(-1, 1)
    
16.             End With
    
17.             wb.Close False
    
18.         End If
    
19.         Filename = Dir
    
20.     Loop
    
21.     Set Sht = Nothing
    
22.     Application.DisplayAlerts = True
    
23. End Sub

复制代码

grf1973

请看附件。

望帝春心

grf1973 发表于 2016-12-7 09:45

学习了，谢谢！