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的行并粘贴它-但是我需要它复制每个^USER下面的行，直到下一个^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 

---

这应该可以完成任务。当.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 

---

这应该可以完成任务。当.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 

---

像这样的东西可能会有帮助，我没有得到正确的文件，所以尝试使用HTML标签的HTML，它可能需要一些调整。它使用脚本运行时参考

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

---

像这样的东西可能会有帮助，我没有得到正确的文件，所以尝试使用HTML标签的HTML，它可能需要一些调整。它使用脚本运行时参考

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