将文本文件导入excel - 每次遇到单词时都开始一个新行

时间:2012-10-26 16:10:24

标签: excel excel-vba vba

我有很多要导入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

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

我的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