[已解决]txt文件名和内容批量导入excel文件

huashang917

百度云附件.求助啊..以前是一个文件一个文件手工导入的.网上收索到的宏都对不上号.急需大师求解

最佳答案

月排行榜 / 总排行榜

苏子龙

2016-11-23 12:44

网上搬砖来的

1. Sub tqwb()
   
2.     Dim a$, b$, i%
   
3.     Dim txtName
   
4.     txtName = Dir(ThisWorkbook.Path & "\*.txt")
   
5.     Range("a:c").ClearContents
   
6.     [a1:c1] = [{"文件名称","编号","数量"}]
   
7.     n = 2
   
8.     Do While txtName <> ""
   
9.         Open ThisWorkbook.Path & "" & txtName For Input As #1
   
10.         i = 1
    
11.         Do While Not EOF(1)
    
12.             Input #1, a, b
    
13.             Cells(n, 1) = Replace(txtName, ".txt", "")
    
14.             Cells(n, 2) = "'" & a
    
15.              Cells(n, 3) = b
    
16.             i = i + 1: n = n + 1
    
17.         Loop
    
18.         Close #1
    
19.        txtName = Dir
    
20.     Loop
    
21. End Sub

复制代码

跳转到最佳答案楼层

苏子龙

网上搬砖来的

1. Sub tqwb()
   
2.     Dim a$, b$, i%
   
3.     Dim txtName
   
4.     txtName = Dir(ThisWorkbook.Path & "\*.txt")
   
5.     Range("a:c").ClearContents
   
6.     [a1:c1] = [{"文件名称","编号","数量"}]
   
7.     n = 2
   
8.     Do While txtName <> ""
   
9.         Open ThisWorkbook.Path & "" & txtName For Input As #1
   
10.         i = 1
    
11.         Do While Not EOF(1)
    
12.             Input #1, a, b
    
13.             Cells(n, 1) = Replace(txtName, ".txt", "")
    
14.             Cells(n, 2) = "'" & a
    
15.              Cells(n, 3) = b
    
16.             i = i + 1: n = n + 1
    
17.         Loop
    
18.         Close #1
    
19.        txtName = Dir
    
20.     Loop
    
21. End Sub

复制代码

huashang917

完美解决我的困扰...谢谢