将文本文件中的特定行复制到excel中

Question

我开发了以下代码来打开大量文本文件（在同一个文件夹中）并将每个文件中的所有内容复制到 excel 中（文本文件的每一行一个单元格，每个文本文件一个行）。

但是，我不需要文本文件中的所有数据，这会减慢处理速度。文本文件格式如下：

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 默认值”）。此示例中的行数为 5（如以“CELL_DATA”开头的行所述，但此数字可能因文件而异。

总而言之，我正在查看我的代码以仅将最后一批数字复制到 excel 中，而不是所有内容，但我不知道如何解决这个问题。

任何帮助或建议将不胜感激。

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

Answer 1

试试这个：

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