VBA 代码搜索字符串，然后搜索第二个字符串并从文本文件返回数据行

Question

我正在尝试搜索大型日志文件以查找文本字符串，然后如果该字符串存在以查找另一个文本字符串，然后返回接下来的 5 行数据。我已经设法在文本文件中搜索字符串并返回 5 行，但是我似乎无法让宏在返回 5 行之前搜索两行文本。

例如，如果文本文件如下所示：

17:42:56: Log File Closed 17:42:56: PrintInvoice: 2 17:42:56: copyReportData: 17:42:56: getNextRptDataID: 17:42:58: CalcDelCharge: 17:42:58: Sub Total: 3.80 17:42:58: Del Total: 0.00 17:42:58: Disc Total: 0.00 17:42:58: Vat Total: 0.00 17:42:58: Inv Total: 3.80 18:33:00: CalculateAmtDue: 18:33:00: CalculateChange: 18:33:00: UpdateDelCharge: 18:33:00: UpdateTotals 18:42:58: CalcDelCharge: 18:42:58: Sub Total: 5.80 18:42:58: Del Total: 0.00 18:42:58: Disc Total: 0.00 18:42:58: Vat Total: 0.00 18:42:58: Inv Total: 5.80

我想提取第一个 'CalcDelCharge' 之后的 5 行，因为它跟在 'PrintInvoice: 2' 之后，这是我也想搜索的字符串之一。

文本文件自始至终都包含“CalcDelCharge”，但我只对出现在“PrintInvoice: 2”之后的实例感兴趣，它出现的频率要低得多。

这是我目前所拥有的

Dim fn As String, txt As String, delim As String, a() As String
Dim i As Long, ii As Long, iii As Long, x, y
fn = "C:\Documents\tilllogfile.log"
delim = vbTab
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
x = Split(temp, vbCrLf)
ReDim a(1 To UBound(x) + 1, 1 To 100)
For i = 0 To UBound(x)
    If InStr(1, x(i), "CalcDelCharge", 1) Then
    For ii = 0 To 5
        n = n + 1: y = Split(x(i + ii), delim)
        For iii = 0 To UBound(y)
            a(n, iii + 1) = y(iii)
        Next
    Next
End If

这将在所有 'CalcDelCharge' 之后提取 5 行并将其放入电子表格中，我无法将其缩小到跟随 'PrintInvoice: 2' 的实例。

任何帮助将不胜感激。

谢谢。

Answer 1

声明布尔变量以告诉宏是否找到了您的文本

Dim boolFound As Boolean

在您最外部的循环中添加第一个测试：

For i = 0 To UBound(x)
    If InStr(1, x(i), "PrintInvoice: 2", 1) Then
        boolFound = True
    End If

在您的第二个测试中添加条件：

If InStr(1, x(i), "CalcDelCharge", 1) And boolFound Then

复制五行后不要忘记将 boolFound 更改为 false：

    boolFound = False
End If

Answer 2

您可以使用 Regex，必须使用 2 个 Regex，但是，可能只使用一个。

Dim str1 As Variant, str2 As Variant
ReDim str1(0 To 100)
ReDim str2(0 To 100)
Dim objMatches As Object
Dim j As Long, k As Long
j = 0
k = 0
Set objRegExp = CreateObject("VBScript.RegExp") 'New regexp
objRegExp.Pattern = "(?:PrintInvoice: 2)[\s\S]*?(?:\s*(?:\d+:)+\s*[\w\s]*:\s\d.*)+" 'https://regex101.com/r/ChRr4w/1/
objRegExp.Global = True
Set objMatches = objRegExp.Execute(temp)
If objMatches.Count <> 0 Then
    For Each m In objMatches
        str1(j) = m.Value
        j = j + 1
    Next
    ReDim Preserve str1(0 To j - 1)
    For j = LBound(str1) To UBound(str1)
    txt = txt & str1(j) & vbCrLf
    Next j
End If
objRegExp.Pattern = "(?:\d+:)+\s*([\w\s]*:\s\d.*)" 'https://regex101.com/r/CLAL9i/1/
Set objMatches = objRegExp.Execute(txt)
  If objMatches.Count <> 0 Then
    For Each m In objMatches
        str2(k) = m.Submatches(0)
        k = k + 1
    Next
    ReDim Preserve str2(0 To k - 1)
    For k = LBound(str2) To UBound(str2)
    result = result & str2(k) & vbCrLf
    Next k
End If
Debug.Print result

结果

Answer 3

这是我的版本（没有布尔值），只是使用了一些嵌套循环。在这里，我们将值放入一个数组中，以便您做任何您想做的事情：

样本数据：

Option Explicit
Sub Test()
Dim searchvalue1 As String, searchvalue2 As String, myarray() As Variant, i As Long, j As Long, k As Long, l As Long

ReDim myarray(0 To 0)
searchvalue1 = "PrintInvoice: 2"
searchvalue2 = "CalcDelCharge:"
l = 1

For i = 1 To 100
    If InStr(Range("A" & i).Value, searchvalue1) > 0 Then
        For j = i + 1 To 100
            If InStr(Range("A" & j).Value, searchvalue2) > 0 Then
                For k = 0 To 4
                    ReDim Preserve myarray(UBound(myarray) + 1) As Variant
                    myarray(k) = Range("A" & j + l).Value
                    l = l + 1
                    Debug.Print myarray(k)
                Next k
            End If
        Next j
    End If
Next i

End Sub

立即窗口：