将特定文本从文本文件导入Excel工作表

时间:2016-06-22 12:26:59

标签: vba excel-vba excel

我正在尝试通过VBA将文本文件导入Excel,但经过大量的搜索和测试后,我似乎无法弄清楚如何格式化它。

这是文本文件的一部分:

^USER ADDRESS
User's name
Street address
Postal code and town
^USER ORDER NUMBER
Order number
^AND SO ON.....

导入时,我希望它格式化为:

^USER ADDRESS | User's name | Street address | Postal code and town
^USER ORDER NUMBER | Order number
^AND SO ON .... 

这是我的脚本。它复制包括^ USER的行并粘贴它 - 但是我需要它来复制每个^下面的行直到下一个^。

Private Sub DatafrmTxt()

Dim myFile As String, text As String
Dim F As Long
Dim x As Integer

myFile = "C:\test.txt"

F = FreeFile
x = 1

Open myFile For Input As F
Do Until EOF(F)
Line Input #F, text

If InStr(text, "^USER ") > 0 Then
Range("A" & x).Value = text
x = x + 1
End If
Loop
Close F

End Sub 

2 个答案:

答案 0 :(得分:1)

这应该可以胜任。当.txt文件中的下一行不是“标题”时,请将相邻列粘贴到x

Private Sub DatafrmTxt()

Dim myFile As String, text As String
Dim F As Long
Dim x As Integer, col As Integer

myFile = "C:\test.txt"

F = FreeFile
x = 1

Open myFile For Input As F
Do Until EOF(F)
Line Input #F, text

   If InStr(text, "^USER ") > 0 Then
      Range("A" & x).Value = text
      x = x + 1
      col = 2
   Else
      Cells(x, col).Value = text
      col = col + 1
   End If

Loop

End Sub 

答案 1 :(得分:1)

这样的东西可能会有所帮助,我没有得到正确的文件,因此使用HTML标签尝试使用HTML,可能需要进行一些调整。它使用Scripting Runtime引用

Sub TestTextStream()

Dim f As Scripting.FileSystemObject
Dim t As Scripting.TextStream
Dim lngRow As Long
Dim intXshift As Integer

Set f = New Scripting.FileSystemObject

 Set t = f.OpenTextFile("c:\test\JavascriptAccordian.txt", ForReading)

lngRow = 1

While Not t.AtEndOfStream

    If Left(t.ReadLine, 1) = "^" Then
        intXshift = 0
        lngRow = lngRow + 1
        Range("a" & lngRow).value = t.ReadLine
    Else
        Range("b" & lngRow).Offset(0, intXshift).value = t.ReadLine
        intXshift = intXshift + 1
    End If

Wend

Set t = Nothing
Set f = Nothing

End Sub