將文本文件導入到excel中 - 每遇到一個單詞時都會啓動一個新行

Question

我有許多文本文件需要導入到excel中。我想讓我的宏打開一個文件，當它遇到單詞「PRICE」時，它將該行放置在A1中。之後的每一行將被放置在b1，c1等。當再次找到PRICE這個詞時，會開始一個新行，並將該行放在a2中，然後是b2，c2中的行。我想我應該使用Instr。下面的代碼似乎將帶有PRiCE的行放在新行中，但文本文件中的以下行似乎不遵循。我想我只需要在DO內進行小調整，而不是循環。任何幫助都會很棒！

x = 1 'to offset rows for each file 

' Loop thru all files in the folder 
For Each file In folder.Files 

' set the starting point to write the data to 
Set cl = ActiveSheet.Cells(x, 1) 

' Open the file 
Set FileText = file.OpenAsTextStream(ForReading) 



i = 0 'to offset columsn for each line 
' Read the file one line at a time 
Do While Not FileText.AtEndOfStream 

    TextLine = FileText.ReadLine 'read line 

    If InStr(TextLine, "FINEX") > 0 Then 'find text 

    x = x + 1 
    Set cl = ActiveSheet.Cells(x, 1) 
    cl.Offset(, 0).Value = TextLine 
    'i = i + 1 
    'cl.Value = TextLine 

    'MsgBox ("yes") 
    Else 
    cl.Offset(, i).Value = TextLine 'fill cell 
    i = i + 1 
    End If 
Loop 

' Clean up 
FileText.Close 

x = x + 1 

Next file 

Answer 1

因爲我昨天幫你這個代碼，碰巧看到，我想我會刺傷採取：

看看下面的代碼獲取它。如果沒有，讓我知道，我可以調整它：

x = 1 'to offset rows for each file and at price 

' Loop thru all files in the folder 
For Each file In folder.Files 

    ' set the starting point to write the data to 
    Set cl = ActiveSheet.Cells(x, 1) 

    ' Open the file 
    Set FileText = file.OpenAsTextStream(ForReading) 

    i = 1 'to offset columsn for each line 

    ' Read the file one line at a time 
    Do While Not FileText.AtEndOfStream 

     TextLine = FileText.ReadLine 'read line 

     If InStr(TextLine, "PRICE") > 0 Then 'find text 

      cl.Offset(x - 1, 0).Value = TextLine 
      x = x + 1 

     Else 

      cl.Offset(x - 1, i).Value = TextLine 'fill cell 
      i = i + 1 

     End If 

    Loop 

Next 

Answer 2

我的2美分

Dim f As File, fileStream As TextStream, filetext As String, NewLines() As String, Offset As Long 

Offset = 1 

Set fileStream = f.OpenAsTextStream(ForReading) 
filetext = fileStream.ReadAll 

filetext = Replace(filetext, vbCrLf, " ") 'make everything one line 
NewLines = Split(filetext, "PRICE") 'make a new set of lines based on PRICE 

For l = LBound(NewLines) To UBound(NewLines) 

    ActiveSheet.Cells(l + Offset, 1) = NewLines(l) 
Next l 

fileStream.Close 
Set fileStream = Nothing