首页 > 解决方案 > 匹配前面不带星号的所有日期

问题描述

我正在尝试使用负面回溯来匹配前面没有星号的所有日期,但它似乎不起作用。

(?<!\\*)(\b(?:0[1-9]|[0-2])/(?:0[1-9]|[12]\d|3[01])/(?:19\d{2}|[2-9]\d{3})\b)

这是我要匹配的字符串:

02/02/2019 *03/20/2019 AB CART 9000341 传真至机构

这是我所拥有的完整代码。它提取单词传真之前的最近日期。问题是,如果前面有一个带星号的日期(例如 *03/20/2019),它会选择它而不是日期(02/02/2019)

这是功能:

Option Explicit
Function lastFaxedDt(s As String) As Date
    Dim re As RegExp, MC As MatchCollection
    Const sPat As String = "(\b(?:0[1-9]|1[0-2])/(?:0[1-9]|[12]\d|3[01])/(?:19\d{2}|[2-9]\d{3})\b)(?=.*?faxed)"
    Set re = New RegExp
    With re
        .Pattern = sPat
        .IgnoreCase = True
        .Global = True
        If .Test(s) = True Then
            Set MC = .Execute(s)
            lastFaxedDt = CDate(MC(MC.Count - 1))
        End If
    End With
End Function

这是宏:

Sub ExtractDate()
    marker = 0
    Set objShell = CreateObject("Shell.Application")
    IE_count = objShell.Windows.Count
    For x = 0 To (IE_count - 1)
        On Error Resume Next
        my_url = objShell.Windows(x).document.Location
        my_title = objShell.Windows(x).document.Title
        If my_title Like "RFT" & "*" Then
            Set IE = objShell.Windows(x)
            marker = 1
            Exit For
        Else
        End If
    Next

    Dim Text As String
    Text = Trim$(IE.document.getElementById("ctl00_ContentPlaceHolder1_txtNotes").innerText)

    ExtractedDate = lastFaxedDt(Text)
    If ExtractedDate = "12:00:00 AM" Then
        ExtractedDate = "0"
    Else
    End If
    ExtractedDate = CLng(ExtractedDate)
    
    MaxDate = Application.WorksheetFunction.Max(ExtractedDate)
    If MaxDate = "0" Then
        MsgBox "No Date Found"
    Else
    End If
    MaxDate = CDate(MaxDate)

    Dim ws5 As Worksheet: Set ws5 = ActiveWorkbook.ActiveSheet
    ws5.Range("C" & (ActiveCell.Row)).Value = MaxDate
    Range("C" & (ActiveCell.Row)).NumberFormat = "[$-409]d-mmm;@"
End Sub

标签: regexvba

解决方案


正如评论中提到的,VBA 不支持 Lookbehinds。要解决此问题,您可以将 Lookbehind 替换为以下内容:

(?:^|[^*])

然后在捕获组(子匹配)中查找日期而不是完整匹配。在这种情况下,您的函数应如下所示:

Function lastFaxedDt(s As String) As Date
    Const sPat As String = _
        "(?:^|[^*])" & _
        "(\b(?:0[1-9]|1[0-2])/(?:0[1-9]|[12]\d|3[01])/(?:19\d{2}|[2-9]\d{3})\b)" & _
        "(?=.*?faxed)"
    Dim re As New RegExp, matches As MatchCollection
    With re
        .Pattern = sPat
        .IgnoreCase = True
        .Global = True
        Set matches = .Execute(s)
        If matches.Count > 0 Then
            Dim lastMatch As Match: Set lastMatch = matches(matches.Count - 1)
            lastFaxedDt = CDate(lastMatch.SubMatches.Item(0))
        Else
            ' TODO: handle the case where no matches are found
        End If
    End With
End Function

用法:

Dim s As String
s = "02/02/2019 *03/20/2019 AB CART 9000341 FAXED TO INSTITUTION"
MsgBox lastFaxedDt(s) ' 02/02/2019

推荐阅读