文本文件行标题到excel中的列

Question

具有以下内容的文本文件：

userId=10101
givenname=Mark
orclmaidenname=Visser
mail=m.visser@somecompany.nl

userID=10102
givenname=Jan
orclmaidenname=Klaassen

userID=10104
givenname=Jessica
orclmaidenname=Host
mail=j.host@somecompany.nl

等等。

如何将此 txt 文件转换为 excel 工作表，其中文本文件中的行标题将是列标题，而 excel 工作表中的行用文本文件中的相应值填充？

txt 文件有 1000 多个项目，但并非所有项目都具有相同的行标题（例如，有些项目没有“邮件”）。

这是我目前所拥有的。它正确地提取了“uid”、“givenname”、“orclmaidenname”。但是，添加“邮件”会导致意外结果。我认为是因为并非所有项目都包含行标题“邮件”。

Sub Frank()

    Application.ScreenUpdating = False

'   Name current file
    MyMacroFile = ActiveWorkbook.Name
'   Prompt for file
    MyFile = Application.GetOpenFilename("All Files,*.*")
    If MyFile = False Then
        Exit Sub
    End If

'   Open file
    Workbooks.OpenText Filename:=MyFile, Origin:=xlWindows, StartRow:=1, _
        DataType:=xlFixedWidth, FieldInfo:=Array(0, 2)
'   Name text file
    MyTextFile = ActiveWorkbook.Name

'   Find cell with "uid", "givenname", "orclmaidenname"
    Do
        Windows(MyTextFile).Activate
'       Exit loop if can't find any matches
        On Error GoTo Err_Fix
            Cells.Find(What:="uid=", After:=ActiveCell, LookIn _
        :=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False).Activate
            Cells.Find(What:="givenname=", After:=ActiveCell, LookIn _
        :=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False).Activate
            Cells.Find(What:="orclmaidenname=", After:=ActiveCell, LookIn _
        :=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False).Activate
        On Error GoTo 0
'   Exit loop if starting search over form top
        If ActiveCell.Row <= MyRow Then
            Exit Do
        End If
'   Get specific characters of selected rows
        MyValue = Right(ActiveCell.Value, 6)
        MyValue2 = Right(ActiveCell.Value, Len(ActiveCell.Value) - 10)
        MyValue3 = Right(ActiveCell.Value, Len(ActiveCell.Value) - 15)
        MyRow = ActiveCell.Row
'   Paste value in spreadsheet with macro in columns A, B and C
        Windows(MyMacroFile).Activate
        Range("A65536").End(xlUp).Offset(1, 0) = MyValue
        Range("B65536").End(xlUp).Offset(1, 0) = MyValue2
        Range("C65536").End(xlUp).Offset(1, 0) = MyValue3
    Loop

Err_Fix:
    Windows(MyTextFile).Activate
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Exit Sub

End Sub

有什么见解吗？

Answer 1

抱歉，这与您的代码不匹配，但我从未使用 VBA 阅读过文本文件，所以我在这里自学。此代码读取文件test.txt，我从您提供的文本中复制了该文件。只要填充了前三个字段，您就不会遇到任何错误，但缺少 mail 字段不是问题。代码的工作原理是在第一行之后的每一行取 = 之后的任何内容，并在空行之后移动到新行。

Option Explicit

Sub test()
    Dim fname As String
    Dim txt As String
    Dim rowID As Long
    Dim colID As Long
    Dim pos As Integer

    fname = "H:\test.txt"
    Open fname For Input As #1

    rowID = 1
    colID = 1

    Do Until EOF(1)
        Line Input #1, txt
        If rowID = 1 And txt <> "" Then
            pos = InStr(1, txt, "=")
            Cells(rowID, colID).Value = Left(txt, pos - 1) 'Populate the field names
            Cells(rowID + 1, colID).Value = Right(txt, Len(txt) - pos) 'Populate the second row (first row of data) 
            colID = colID + 1
        ElseIf txt = "" Then
            If rowID = 1 Then rowID = rowID + 1 'Increase the rowID by 1 since we have already populated the first row of data.
            colID = 1     'Set the colID back to 1 for the new row
            rowID = rowID + 1   'Move to a new row
        Else
            pos = InStr(1, txt, "=")
            Cells(rowID, colID).Value = Right(txt, Len(txt) - pos)  'Print out everything after the "=" to the cell
            colID = colID + 1    'Move to new column
        End If
    Loop

    Close #1

End Sub