VBA 代码用于搜索字符串，然后是文本文件中的第二个字符串和 return 行数据

Question

我正在尝试搜索大型日志文件以查找文本字符串，然后如果该字符串存在则查找另一个文本字符串，然后 return 接下来的 5 行数据。我已经设法在文本文件中搜索字符串和 return 之后的 5 行，但是我似乎无法让宏在 return 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

这最终会提取 5 行 'CalcDelCharge' 并将其放入我的电子表格中，我无法将其缩小到 'PrintInvoice: 2'.[=14 之后的实例=]

如有任何帮助，我们将不胜感激。

谢谢。

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

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

示例数据：

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

立即window:

Answer 3

您可以使用 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

VBA 代码用于搜索字符串，然后是文本文件中的第二个字符串和 return 行数据

VBA code to search for string then a second string and return lines of data from a text file

excel

string

vba

text-files

text-extraction

结果