Question

如何将多个txt批量导入Excel并以txt文件名命名工作表名称

Answer 1

举例：
假设所有的文本文件都在“D:\text”目录下，只处理.txt文件。

步骤1：导出文件列表
点xp系统的开始菜单，点“运行”命令，输入cmd再回车，进入命令窗口，输入

命令 dir D:\text\*.txt /b /on > c:\list.txt ,回车。现在在c:盘下会有个list文件，包含要处理de文件的文件名。

步骤2：运行下面代码。
Option Explicit
Public Const sPath As String = "D:\text" '请改为你的txt所在的路径
Public FileName() As String '要处理的文件名
Public MyString() As String '从text中读取内容

Sub ReadFile()
Dim getLine '每次读取一行数据
Dim i%, t%, k%

i = FreeFile
Open "c:\list.txt" For Input As #i ' 打开输入文件。
Do While Not EOF(i)
Input #i, getLine '将数据读入变量。
t = t + 1
Loop
k = t - 1
ReDim FileName(k), MyString(k)
t = 0
Seek #i, 1 '设置文件的第一条记录
Do While Not EOF(i)
Input #i, FileName(t)
FileName(t) = sPath & "\" & FileName(t)
t = t + 1
Loop
Close #i ' 关闭文件。

'读取txt内容到本excel表格
For t = 0 To k
i = FreeFile
Open FileName(t) For Input As #i
Do While Not EOF(i)
Input #i, getLine
MyString(t) = MyString(t) & vbNewLine & getLine
Loop
Close #i
With ThisWorkbook.Sheets(1)
.Cells(t + 1, 1) = FileName(t)
.Cells(t + 1, 2) = Right(MyString(t), Len(MyString(t)) - 2)
End With
Next t

End Sub

Answer 2

使用如下VBA代码实现，复制粘贴到VBA模块中运行即可（alt+F11)。

Sub import_txt()
On Error Resume Next
Dim my_Link, my_Doc As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
my_Link = .SelectedItems(1)
End With

Dim doc_Count As Single
doc_Count = 0
my_Doc = Dir(my_Link & "\" & "*.txt")

Do While Len(my_Doc) <> 0
Worksheets.Add
ActiveSheet.Name = my_Doc
Dim my_Word As String
Dim i As Single
i = 1
Open my_Link & "\" & my_Doc For Input As #1
Do While Not EOF(1)
Line Input #1, my_Word
Cells(i, 1) = my_Word
i = i + 1
Loop
Close
doc_Count = doc_Count + 1
my_Doc = Dir
Loop
MsgBox "共导入" & doc_Count & "个文件"
End Sub

Answer 3

由于你没有TXT样例，所以我只能简单说一下过程
最合理的办法是采用编写一段vba的方式来做
先是遍历TXT所在的整个文件夹，依次打开文件，取得文件名，并在excel中建立相应的sheets
再把文件中的数据按要求逐行写入excel，并关闭文件
以此循环直至结束

Answer 4

VBA轻松实现。