從文本文件中的特定行復制到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」開始的行中所指出的，但是這個數字可以從文件到文件改變）。

總之，我正在查看我的代碼，只將最後一批數字複製到出類拔萃的，而不是一切，但我在就如何解決這個虧損

任何幫助或建議將不勝感激

子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