将特定行从文本文件复制到Excel [英] Copy specific lines from text files into excel
问题描述
我开发了以下代码来打开大量文本文件(在同一文件夹中),并将每个文件中的所有内容复制到excel(文本文件的每一行一个单元格,每个文本文件一行一个).
I have developed the below code to open a large number of text files (within the same folder) and copy everything from each file into excel (one cell for each line of text file & one row for each text file).
但是,我并不需要文本文件中的所有数据,这正在减慢该过程.文本文件的格式如下:
However, I do not require all of the data from the text files and it is slowing down the process. The text files are in following format:
DATASET UNSTRUCTURED_GRID
POINTS 5 float
0.096853 0.000000 0.111997
0.096853 -0.003500 0.111997
0.096890 0.000000 0.084015
0.096853 -0.003500 0.111997
0.096890 -0.003500 0.084015
CELL_DATA 5
SCALARS pressure float 1
LOOKUP_TABLE default
-0.000000
-0.000000
-3.000000
-2.000000
-6.000000
我需要从该文件复制的数据是第二批数字(在"LOOKUP_TABLE默认值"下方).在此示例中,行数为五(如在"CELL_DATA"开头的行中所述,但是该数目可以在文件之间更改.
The data that I need to copy from this file is the second batch of numbers (below "LOOKUP_TABLE default"). The number of lines in this example is five (as stated on line starting "CELL_DATA" but this number can change from file to file.
总而言之,我正在寻找只将最后一批数字而不是所有内容复制到excel中的代码,但是我对如何解决这个问题感到茫然.
In summary, I'm looking my code to only copy this last batch of numbers into excel instead of everything but I'm at a loss on how to tackle this.
任何帮助或建议,将不胜感激.
Any help or advice would be greatly appreciated.
Sub ImportTextFile()
Sub ImportTextFile()
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As String
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Long
Dim SaveColNdx As Integer
FName = "E:\zdump\"
MyFile = Dir(FName & "*.txt")
Sep = vbLf
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Do While MyFile <> ""
Open (FName & MyFile) For Input As #1
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
Close #1
MyFile = Dir()
Debug.Print text
Loop End Sub
推荐答案
尝试一下:
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As String
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Long
Dim SaveColNdx As Integer
Dim SaveRowNdx As Long
Dim FoundData As Boolean
Dim NumberOfData As Long
FName = "E:\zdump\"
MyFile = Dir(FName & "*.txt")
Sep = vbLf
ColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
SaveRowNdx = RowNdx
Do While MyFile <> ""
Open (FName & MyFile) For Input As #1
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
If FoundData = False Then
If InStr(TempVal, "CELL_DATA") Then
NumberOfData = Val(Right(TempVal, Len(TempVal) - Len(Left(TempVal, Len("CELL_DATA") + 1))))
End If
If InStr(TempVal, "LOOKUP_TABLE default") <> 0 Then
FoundData = True
End If
Pos = NextPos + 1
NextPos = InStr(Pos, WholeLine, Sep)
Else
If NumberOfData <> 0 Then
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
RowNdx = RowNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
NumberOfData = NumberOfData - 1
End If
End If
Wend
Wend
Close #1
FoundData = False
ColNdx = ColNdx + 1
Cells(SaveRowNdx, ColNdx).Activate
RowNdx = SaveRowNdx
MyFile = Dir()
'Debug.Print Text
Loop
这篇关于将特定行从文本文件复制到Excel的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!