如何用EXCEL搜索一个文件夹中N个TXT文档中的指定行数据？

Question

桌面指定文件夹
文件夹里面的文档
FFC格式用TXT格式打开后里面的数据
指定选取行数据
求高手编个VBA，谢谢！

Answer 1

Public Sub ExtractLine()
Dim strFolder As String
Dim strContent As String
Dim lngLine As Long, i As Long, lngRow As Long 'txt中指定行号，计数器，sheet1中行号
Dim strFile As String '文件名

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择txt文本所在目录"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
strFolder = .SelectedItems(1)
End If
End With

lngLine = 3 '指定读取每个txt文件的第n行
lngRow = 1
strFile = Dir(strFolder & "\*.FFC", vbNormal)
Do While strFile <> ""
ThisWorkbook.Sheets("sheet1").Cells(lngRow, 1).Value = strFile 'A列为txt文件名
Open strFolder & "\" & strFile For Input As #1
i = 1 '初始化计数器
Do While Not EOF(1)
Line Input #1, strContent
If i = lngLine Then
Exit Do
End If
i = i + 1
Loop
Close #1
ThisWorkbook.Sheets("sheet1").Cells(lngRow, 2).Value = strContent 'B列为txt文件指定行内容
lngRow = lngRow + 1 '结果行增1
strFile = Dir
Loop

MsgBox "共提取：" & lngRow - 1 & "个txt文件指定行内容！"

End Sub

结果会在当前excel的sheet1中列出所有FFC文件名和指定行内容。追问

只读取了带01的这行，而带03,13,15,28,30的行没有，大侠，再帮帮，非常感谢！

追答

我的代码中这行：
lngLine = 3 '指定读取每个txt文件的第n行

表示你要搜索的这些文件中的第几行。你在每次运行前修改这个数字就可以了。

追问

如果一次一次运行("3", "5", "15", "17", "30", "32")行的话，最后我还要

按这个顺序集中排列，也很麻烦的，除非你再帮我写一个或者给个公式，谢谢！

追答

如果你以后需要经常进行这种应用，我可以再完善一下代码。

Answer 2

excel打开txt文件我做过，这个FFC能不能用excel打开，我没试过。FFC文件能发一个给我看看吗？油箱chenjiawei50到163追问

是否能做到？亲

追答

能，excel可以直接打开FFC文件，所以代码我能写。
Izysuc不是给你写代码了吗？我看不懂ta写的，如果是我写，就用最普通的opentext方法来做。

你要搜索的内容是什么？哪一行，什么内容？搜出来之后怎样，是复制保存吗？这些你都没说清楚。

追问

黄色的行就是我要搜索出来的行，复制保存到新的工作表就OK！二楼的兄弟写的只能搜索到FF_N-Stand;01;的行，还有5行没搜索到。



追答

每个FFC文件中都有这6行吗？

追问

是的，而且位置相同。

追答

今天有点忙，没时间写。晚上抽空做吧。这是我的油箱chenjiawei50到163

昨天收到你的一个ffc文件，你可以再多发几个给我，我比较一下看看格式。

你说每个文件都有这6行，且位置相同，那么我只需要在一个ffc文件中找到这6行，并且分别记住这6行的行号，然后再逐一打开每个ffc文件，都去抽取这些行号的内容就可以了。对吧。

资料发我油箱，做好给你回复。

Sub GetFFC()
Dim FFCName, i As Integer, j As Integer, GetRowNum, MyWb As Object, CopyRange As Range
GetRowNum = Array("3", "5", "15", "17", "30", "32") '抽取这些固定的行号
FFCName = Application.GetOpenFilename("FFC文件,*.ffc,TXT文件,*.txt", , "请选择多个文件（可以全选）!!!!!", , True)
If TypeName(FFCName) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
For i = 1 To UBound(FFCName)
    Workbooks.OpenText FileName:=FFCName(i), DataType:=xlFixedWidth
    Set MyWb = ActiveWorkbook
    With MyWb.Sheets(1)
        Set CopyRange = .Cells(GetRowNum(0), 1)
        For j = 1 To UBound(GetRowNum)
            Set CopyRange = Union(CopyRange, .Cells(GetRowNum(j), 1))
        Next j
        CopyRange.Copy ThisWorkbook.Sheets(1).Cells(1, i)
    End With
    MyWb.Close 0
Next i
Set CopyRange = Nothing
Set MyWb = Nothing
Application.ScreenUpdating = True
End Sub

追问

亲，其实我的文件夹里面有6000多个FFC文件，就是我要把这6000多个FFC文件里面的指定那几行取出来，并且要像这样一直往下排列。而你写的这个要一个个打开才行，多选也读取不了那么多，全选就直接进修复了。二楼的其实很对，但是只搜到了01。（亲，你复制我发给你的那个就行了，全部都一样的）。解决问题追分，非常感谢！

追答

“多选也读取不了那么多，全选就直接进修复了。”——这句话什么意思？6000个文件，你ctrl+A全选就是了。
二楼的代码我不会。

追问

虽然没解决问题，但还是非常感谢！全选EXCEL直接奔溃了，我试过多选，但是也只搜到了3个FFC的数据！

追答

采纳了就代表问题解决。