Question

怎么将同一文件夹下,N个TXT文件的内容（TXT格式一样），批量储存到excel里。

TXT格式
```````````````````

[名词]
安。。。。。

[英文名称]
M。。。。。

[注释]
用。。。。。

EXCEL：
每个TXT文件存一行，带[]的只有第一行是，其他行只存不带[]的。

用.net或vba写都可以，谢谢了!!

Answer 1

Private Sub CommandButton1_Click()

Dim qwjm As String
Dim wjm As String

    ThisWorkbook.Sheets(1).Cells(1, 1) = "[名词]"
    ThisWorkbook.Sheets(1).Cells(1, 2) = "[英文名称]"
    ThisWorkbook.Sheets(1).Cells(1, 3) = "[注释]"
    han = 1
    aaa = ThisWorkbook.Name
    myFileName = ThisWorkbook.Path & "\" & "*.txt"
    wjm = Dir(myFileName)
       If wjm <> "" Then
            Do While wjm <> ""
            han = han + 1
            qwjm = ThisWorkbook.Path & "\" & wjm
            Application.ScreenUpdating = False
            Workbooks.Open qwjm
                Set a1 = ActiveSheet.Cells.Find(what:="[名词]", LookIn:=xlValues)
                Set a2 = ActiveSheet.Cells.Find(what:="[英文名称]", LookIn:=xlValues)
                Set a3 = ActiveSheet.Cells.Find(what:="[注释]", LookIn:=xlValues)
                If Not a1 Is Nothing Then
                    han1 = a1.Row
                    han2 = a2.Row
                    han3 = a3.Row
                    wb = ""
                    For x = han1 + 1 To han2 - 1
                        wb = wb & Sheets(1).Cells(x, 1) & Chr(10)
                    Next x
                    ThisWorkbook.Sheets(1).Cells(han, 1) = wb
                   
                    wb = ""
                    For x = han2 + 1 To han3 - 1
                        wb = wb & Sheets(1).Cells(x, 1) & Chr(10)
                    Next x
                    ThisWorkbook.Sheets(1).Cells(han, 2) = wb
                   
                    wb = ""
                    For x = han3 + 1 To Sheets(1).UsedRange.Rows.Count
                        wb = wb & Sheets(1).Cells(x, 1) & Chr(10)
                    Next x
                    ThisWorkbook.Sheets(1).Cells(han, 3) = wb
                End If
           
            Workbooks(wjm).Close
            wjm = Dir
            Loop
       End If

End Sub

如图：

 

Answer 2

在excel中读入.txt内容，读入时采用分列等方法达到你的要求，把生成的数据复制到需要存储的位置（最好另一工作簿），接着就简单了，对生成的表刷新，选新的txt文档，再复制粘贴。重复操作就可以了。

Answer 3

在sheet1工作表上新建一个按钮，然后在sheet1模块中输入以下代码：
Private Sub Commandbutton1_click()
Dim spath As String
Dim sfilename() As String
Dim totalfiles As Integer
Dim sh As Object
Dim fol, filename
Dim txt() As String, textline As String

Set sh = CreateObject("shell.application")
Set fol = sh.browseforfolder(0, "选择文件夹", 30)
For Each filename In fol.items
If filename Like "*.txt" Then
totalfiles = totalfiles + 1
ReDim Preserve sfilename(1 To totalfiles)
sfilename(totalfiles) = fol.items.Item.Path & "\" & filename
End If
Next filename

totalfiles = UBound(sfilename)
ReDim txt(1 To totalfiles)

For i = 1 To totalfiles
Open sfilename(i) For Input As #1
Do While Not EOF(1)
Line Input #1, textline
txt(i) = txt(i) & textline & Chr(13)
Loop
Close #1
Next i

Cells(1, 1) = "[名词]"
Cells(1, 2) = "[英文名称]"
Cells(1, 3) = "[注释]"

For i = 1 To totalfiles
Call t(txt(i), i)
Next i
End Sub

Sub t(ByVal text As String, ByVal r As Long)
Dim txt As String
Dim n As Integer
Dim l As Long

l = Len(text)
n = WorksheetFunction.Find("]", text, 1)
text = Right(text, l - n)
n = WorksheetFunction.Find("[", text, 1)
Cells(r + 1, 1) = Trim(Left(text, n - 1))

l = Len(text)
n = WorksheetFunction.Find("]", text, 1)
text = Right(text, l - n)
n = WorksheetFunction.Find("[", text, 1)
Cells(r + 1, 2) = Trim(Left(text, n - 1))

l = Len(text)
n = WorksheetFunction.Find("]", text, 1)
Cells(r + 1, 3) = Trim(Right(text, l - n))
End Sub

点击按钮后会弹出一个文件夹浏览框，选择你存TXT的文件夹。（PS：由于懒得写容错代码，如果你点了“取消”会出错，如果你选择的文件夹是桌面会出错，如果你选择的文件夹里含有内容不是你上面所说那种格式的TXT的话也会出错，选桌面会出错这个问题我一直没想明白，求shell.application这一块比较牛的大神指点。）