Extracting data from a txt file to Excel via vba

sxpgvts3  于 2022-12-14  发布在  其他
关注(0)|答案(1)|浏览(115)

我试图从一个txt文件中提取数据,并将它们放入一个结构化的Excel表中。txt文件看起来像这样。

Date 28.07.2022 Time: 16:52
New File
Date 28.07.2022 Time: 16:52
A: 83.24
B 2220900102 C 30.23
D=6 E=3 F=130
G -14.9
H 0.006
I -0.004
J 83.287 K 83.268
...

虽然我能够提取第一组数据,但我无法在表中显示以下任何一组数据。我能找到的最接近我的问题的是this,但除非我错过了,否则他们告诉他要做的唯一事情就是在代码中实现一个循环。我试着这样做,到目前为止我的代码看起来是这样的。

Sub Button()
    Dim myFile As String, text As String, textline As String
    Dim posA As Integer, posB As Integer, ...
    Dim i As Long
    myFile = "Path\myFile.TXT"
    Open myFile For Input As #1
    i = 1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
        posDate = InStr(text, "Date")
        If posDate = 1 Then
            i = i + 1
        End If
        posTime = InStr(text, "Time")
        posA = InStr(text, "A")
        ...
        Cells(i, 1).Value = Mid(text, posDate + 5, 10)
        Cells(i, 2).Value = Mid(text, posTime + 6, 5)
        Cells(i, 3).Value = Mid(text, posA + 27, 5)
        ...
    Loop
    Close #1
End Sub

我不知道如何改变它,因为我有很少的经验与vba。

cngwdvgl

cngwdvgl1#

Try using a Regular Expression.

Option Explicit

Sub extract()

    Const TEXTFILE = "data.txt"
   
    Dim wb As Workbook, ws As Worksheet, r As Long, ar
    Dim fso As Object, ts As Object, n As Long, s As String
    Dim c As String, v As String
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    ' results sheet header
    ws.Range("A1:M1") = Array("Date", "Time", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K")
    r = 1
    
    'create regex engine
    Dim Regex As Object, sPattern As String, m As Object, i As Long
    Set Regex = CreateObject("vbscript.regexp")
    
    sPattern = "([A-Z])[ =:]*([-0-9.]+)"
    With Regex
      .Global = True
      .MultiLine = False
      .IgnoreCase = True
      .Pattern = sPattern
    End With
    
    ' open text file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(TEXTFILE, 1)
        
    ' read lines
    Do While ts.AtEndOfLine <> True
        n = n + 1
        s = ts.readline
        
        ' check for date and start new line
        If Left(s, 4) = "Date" Then
            r = r + 1
            ar = Split(s, " ")
            ws.Cells(r, 1) = ar(1) ' date
            ws.Cells(r, 2) = ar(3) ' time
            
        ' check for pattern
        ElseIf Regex.test(s) Then
            Set m = Regex.Execute(s) ' matches
            For i = 0 To m.Count - 1
               c = m(i).submatches(0) ' column
               v = m(i).submatches(1) ' value
               ws.Cells(r, c).Offset(0, 2) = v
            Next
        End If
        
    Loop
    ts.Close

    MsgBox n & " lines read from " & TEXTFILE, vbInformation

End Sub

相关问题