VBA脚本查看txt文件中的特定信息并将其粘贴到excel中

Question

首先，我要说的是，我是新来的，我希望我在正确的“频道”中写这篇文章！

最近我一直在处理一个excel，要查找txt文件中的某些信息，然后将其粘贴到工作表中。我的问题是从包含不同定义字符串的不同行复制信息。

示例： txt 文件就像一本日志。此日志具有类似 |UPDATED|、|CREATED| 的入口和|更新|。记录此信息后，将跟随不同数量的行，直到“主题”以符号“->”结束。 所以，我希望脚本做的是，假设查找字符串 |UPDATED|，复制整行并粘贴到 Excel 中。然后继续滚动 txt 文件行，直到找到“->”，复制该行并将其放在相应的“标题”下方（已更新、已创建、已更新）。

如果有一种方法可以让它记录它找到变量入口的行，那么它会更有帮助，就像我可以做的那样，例如 const= const - 2，在 txt 文件中上升两个行并复制该内容！

Sub PS_automation()

Dim ReadData As String
Dim x As Integer, y As Integer, z As Integer, p As Integer
x = 1
y = 1
z = 1
p = 1

Open "C:\Users\racastr1\Desktop\PS_AUTOMATE.txt" For Input As #1 
    
Do Until EOF(1)
    
Line Input #1, ReadData 
    
If InStr(Left(ReadData, 9), "|CREATED|") Then
Cells(x, 1) = ReadData
x = x + 1
    Else
    If InStr(Left(ReadData, 8), "|CLOSED|") Then
    Cells(y, 2) = ReadData
    y = y + 1
        Else
        If InStr(Left(ReadData, 9), "|UPDATED|") Then
        Cells(z, 3) = ReadData
        z = z + 1
        End If
    End If
End If
Loop
Close #1
End Sub

这已经复制了提到的入口，但是如果我有相同的条件来查找“->”，它不会按顺序将其粘贴到工作表中（因此它不会进入关联的“标题”。 文件示例：

Answer 1

你可以尝试这样的事情：

Sub PS_automation()
    
    Const TXT_PATH As String = "C:\Users\racastr1\Desktop\PS_AUTOMATE.txt"
    
    Dim data As String, arr, i As Long, s As String, col As Long
    Dim ws As Worksheet
    
    data = GetContent(TXT_PATH)        'read the whole file
    data = Replace(data, vbcrlf, vbLf) 'normalize line separators
    arr = Split(data, vbLf)            'split to array
    
    Set ws = ActiveSheet 'or some specific sheet
    
    For i = 1 To UBound(arr) 'loop over the lines
        s = arr(i)
        Select Case True
            Case Left(s, 9) = "|CREATED|"
                col = 1
                ws.Cells(Rows.Count, col).End(xlUp).Offset(1).Value = s
            Case Left(s, 8) = "|CLOSED|"
                col = 2
                ws.Cells(Rows.Count, col).End(xlUp).Offset(1).Value = s
            Case Left(s, 9) = "|UPDATED|"
                col = 3
                ws.Cells(Rows.Count, col).End(xlUp).Offset(1).Value = s
            Case Left(s, 2) = "->"
                If col > 0 Then  'previous entry was read? Write to same column
                    ws.Cells(Rows.Count, col).End(xlUp).Offset(1).Value = s
                Else
                    '??? do what ???
                End If
        End Select
    Next i
End Sub


Function GetContent(f As String) As String
    GetContent = CreateObject("scripting.filesystemobject"). _
                  OpenTextFile(f, 1).ReadAll()
End Function