使用VBA将文本文件解析为excel

Question

我是 VBA 的新手，我可以为过去 3 天一直在苦苦挣扎的程序提供一些帮助。 我在一个文本文件中有很多数据，排列为 3 列。此数据必须在 Excel 中解析 第 1 列对应于时间，第 2 列对应于变量，第 3 列对应于变量的值。 excel 应该以这样的方式解析数据，即第 1 列有时间，第 2、3、4、5、6、7 列的值对应于文本文件第 2 列中的变量。并且值是十六进制 datei 必须转换为十进制。 这是代码

Sub OpenText()
Dim MyFile As Variant
Dim TempWb As Workbook
Dim DestSh As Worksheet
Dim i As Long, p As Long, LimitRow As Long
Dim LastRow As Long
Dim LastRow2 As Long
p = 2

' Ask the user for the file name to open.
MyFile = Application.GetOpenFilename()
' Check for the Cancel button.
If MyFile = False Then Exit Sub
Application.ScreenUpdating = False

Set DestSh = ThisWorkbook.ActiveSheet

'Open the Text file with the OpenText method.

  Workbooks.OpenText Filename:=MyFile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar _
    :=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
    1), Array(6, 1), Array(7, 1)), _
    DecimalSeparator:=".", ThousandsSeparator:=" ", TrailingMinusNumbers:= _
    True
    Set TempWb = ActiveWorkbook
    LimitRow = 1048576 'Version Excel 2010
    LastRow = Range("A" & LimitRow).End(xlUp).Row

         If LastRow > 0 Then

         For i = 1 To LastRow

         If i = 1 Then
            Cells(p, 1).Value = Cells(i, 1).Value
        End If

        Test = Cells(i, 2).Value
            If Test = "0x005B" Then Cells(p, 2).Value = Cells(i, 3).Value Else _
            If Test = "0x003E" Then Cells(p, 3).Value = Cells(i, 4).Value Else _
            If Test = "0x0033" Then Cells(p, 4).Value = Cells(i, 3).Value Else _
            If Test = "0x0039" Then Cells(p, 5).Value = Cells(i, 3).Value Else _
            If Test = "0x003B" Then Cells(p, 6).Value = Cells(i, 3).Value Else _
            If Test = "0x003D" Then Cells(p, 7).Value = Cells(i, 3).Value Else _

        Next


  End If
 End Sub

文本文件看起来有点像这样

    2017-03-23_11-48-32.8;0x003E;0x1000
    2017-03-23_11-48-32.8;0x0033;0x01F4
    2017-03-23_11-48-32.8;0x0039;0x6720
    2017-03-23_11-48-32.8;0x003B;0x6720
    2017-03-23_11-48-32.8;0x003D;0x0050
    2017-03-23_11-48-32.8;0x005E;0x1234ABCD
    2017-03-23_11-48-33.1;0x0033;0x01F4
    2017-03-23_11-48-33.1;0x0039;0x6720
    2017-03-23_11-48-33.1;0x003B;0x6720
    2017-03-23_11-48-33.4;0x003E;0x1000
    2017-03-23_11-48-33.4;0x0033;0x01F4
    2017-03-23_11-48-33.4;0x0039;0x6720
    2017-03-23_11-48-33.4;0x003B;0x6720
    2017-03-23_11-48-33.4;0x003D;0x0050
    2017-03-23_11-48-33.4;0x005E;0x1234ABCD
    2017-03-23_11-48-33.7;0x0033;0x01F4
    2017-03-23_11-48-33.7;0x0039;0x6720
    2017-03-23_11-48-34.0;0x003E;0x1000
    2017-03-23_11-48-34.0;0x0033;0x01F4
    2017-03-23_11-48-34.0;0x0039;0x6720
    2017-03-23_11-48-34.0;0x003B;0x6720
    2017-03-23_11-48-34.0;0x003D;0x0050
    2017-03-23_11-48-34.0;0x005E;0x1234ABCD
    2017-03-23_11-48-34.3;0x0033;0x01F4
    2017-03-23_11-48-34.3;0x0039;0x6720
    2017-03-23_11-48-34.3;0x003B;0x6720
    2017-03-23_11-48-34.6;0x003E;0x1000
    2017-03-23_11-48-34.6;0x0033;0x01F4
    2017-03-23_11-48-34.6;0x0039;0x6720
    2017-03-23_11-48-34.6;0x003B;0x6720
    2017-03-23_11-48-34.6;0x003D;0x0050
    2017-03-23_11-48-34.6;0x005E;0x1234ABCD
    2017-03-23_11-48-34.9;0x0033;0x01F4
    2017-03-23_11-48-34.9;0x0039;0x6720
    2017-03-23_11-48-34.9;0x003B;0x6720
    2017-03-23_11-48-35.2;0x003E;0x1000
    2017-03-23_11-48-35.2;0x0033;0x01F4
    2017-03-23_11-48-35.2;0x0039;0x6720
    2017-03-23_11-48-35.2;0x003B;0x6720
    2017-03-23_11-48-35.2;0x003D;0x0050
    2017-03-23_11-48-35.2;0x005E;0x1234ABCD
    2017-03-23_11-48-35.5;0x0033;0x01F4
    2017-03-23_11-48-35.5;0x0039;0x6720
    2017-03-23_11-48-35.5;0x003B;0x6720

Excel 也是在不同的工作表而不是当前工作表中创建的。

提前致谢

Answer 1

希望这能解决你的问题

Public Sub Append_text()
Set fso = New FileSystemObject
FLoc = "Y:\Macro\Test" & Format(Now(), "HHMMSS") & ".txt"
Set Stream = fso.OpenTextFile(FLoc, ForAppending, True)
x = 1 'Hoping the start point
Do Until Sheet1.Cells(x, 1) = "" 'U can use the end of file code here for looping till last row
    Stream.Write Sheet1.Cells(x, 1) & ";" & Sheet1.Cells(x, 2) & ";" & Sheet1.Cells(x, 3) & vbNewLine
    x = x + 1
Loop
End Sub

Public Sub Read_text()
Sheet2.Activate
Set fso = New FileSystemObject
Fname = Application.GetOpenFilename
x = 1
y = 1
Set Stream = fso.OpenTextFile(Fname, ForReading, True)
Do While Not Stream.AtEndOfStream
          Str_text = Stream.ReadLine 'Perform your actions
          rdtext = Split(Str_text, ";")
          Sheet2.Cells(x, y) = rdtext(0)
          Sheet2.Cells(x, y + 1) = rdtext(1)
          Sheet2.Cells(x, y + 2) = rdtext(2)
          x = x + 1
          y = 1
Loop
Stream.Close
End Sub

Answer 2

不是直接指出问题，而是回答 Parsing Text file using VBA。

这是一个自动检测例程。您可以通过临时替换没有参数的子行并添加它来将其添加到自定义选项卡中。然后用带有可选参数的 real 行替换 Sub 行。

如果您未指定任何可选分隔符，则会查看文件的前 5 行并检查常见分隔符。例如，如果其中任何一行包含超过 8 个管道，则假定管道是分隔符。

注意评论中的“自动逗号分割”问题。这是一个 EXCEL 的怪癖，不是 .TextToColumns 的问题。当有人使用 Get External Data 或 Data Tools > Text to Columns 时，Excel 会“记住”以前在“数据”选项卡中所做的选择，并且可能会自动重新在打开文件时执行那个解析。

Option Explicit

Sub Parse_any_delimited( _
    Optional ByVal dlm_pipe As Boolean = False, _
    Optional ByVal dlm_semi As Boolean = False, _
    Optional ByVal dlm_comma As Boolean = False, _
    Optional ByVal dlm_tab As Boolean = False, _
    Optional ByVal dlm_carat As Boolean = False, _
    Optional ByVal dlm_char As String = "", _
    Optional ByVal no_delim_popup As Boolean = True)


' *** WARNING !!! ***
'
' The FIRST record that EXCEL will see DURING AN IMPORT CANNOT CONTAIN
' COMMAS! IF IT DOES, it interprets those as DELIMITERS and AUTOMATICALLY
' does a field split there BEFORE running any code!  The result is that
' when all text SHOULD wind up in Cell A1, instead it gets parsed into
' cells at each comma.  Then the REAL PARSE routine can only parse what
' IS in the Column A cells.
'
' The "comma parse" UPON LOADING occurs BEFORE any macro runs!

    Dim i As Integer
    Dim check_data As Boolean
        check_data = False

    Dim dlm_other As Boolean
        dlm_other = False
    Dim rcrd As Variant
    Dim leave_for As Boolean
    Dim have_delim As Boolean


'1 ****
    If dlm_pipe Then
        dlm_other = True
        dlm_char = "|"
        have_delim = True

'2 ****
    ElseIf dlm_carat Then
        dlm_other = True
        dlm_char = "^"
        have_delim = True

'3 ****
    ElseIf dlm_tab Or dlm_semi Or dlm_comma Then
         have_delim = True

'4 ****
    Else
        For i = 1 To 5  'Check first 5 records for common delimiters
            leave_for = True
            rcrd = Cells(i, "A").Value

            If Count_Characters(rcrd, "|") > 5 Then
                dlm_other = True
                dlm_char = "|"

            ElseIf Count_Characters(rcrd, ";") > 5 Then
                dlm_semi = True

            ElseIf Count_Characters(rcrd, ",") > 10 Then
                dlm_comma = True

            ElseIf Count_Characters(rcrd, vbTab) > 4 Then
                dlm_tab = True

            ElseIf Count_Characters(rcrd, "^") > 5 Then
                dlm_other = True
                dlm_char = "^"

            Else
                leave_for = False
            End If

      '===============
            If leave_for Then
                have_delim = True
                Exit For
            Else
                have_delim = False
            End If

        Next i

'5 ****
    End If

    If have_delim = False Then
        ' B2 is checked because in certain cases Excel will
        ' AUTOMATICALLY parse data delimited by | or semicolons.
        ' When that happens, THIS sub sees it as "No delimiter Can't Parse"
        ' even though it HAS BEEN parsed.
        If Cells(2, "B").Value = "" And no_delim_popup Then
            MsgBox ("CAN'T PARSE - NO DELIMITER FOUND")
        End If

        Exit Sub
    End If

    ' Stops "There's already data here--continue?"
    Application.DisplayAlerts = False

    Columns("A:A").Select
    Selection.TextToColumns _
        Destination:=Range("A1"), _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, _
            Tab:=dlm_tab, _
            Semicolon:=dlm_semi, _
            Comma:=dlm_comma, _
            Space:=False, _
            Other:=dlm_other, _
            OtherChar:=dlm_char

    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select

    Application.DisplayAlerts = True

' Sub Parse_any_delimited()
End Sub


Function Count_Characters( _
    ByVal str As Variant, _
    ByVal chr As Variant) _
      As Long
    Count_Characters = Len(str) - Len(Replace(str, chr, ""))
End Function