VBA：字符串中的最大日期

Question

如何从具有多个日期值和不同字符的字符串中获取 MAX 日期？

字符串示例：

11AUG2016更改gggqqq2i8yj 29SEP2016移除tyijdg298 30SEP2016添加，mkdjenb200 03OCT2016 zzxxddd4423 04OCT2016 jioi == ++ - 234jju 24OCT2016更新tuiomahdkj 10JAN2017更新ZZZZ T4123III 13JAN2017更新jukalzzz123 20JAN2017 iiiwwwaazz678uuh P>

Answer 1

只是为了转折，我更喜欢使用这个正则表达式：

((0[1-9]|1[0-9]|2[0-9]|3[0-1])(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)([0-9][0-9][0-9][1-9]))

这将过滤掉00FOO 或99DEX 之类的字符串以及日期和月份之类的东西。如果年份是0000，也会拒绝。

有3个捕获组，所以可以用SubMatches(i)拉出日、月、年。

最大日期是通过在填充有匹配项本身的数组上使用 WorksheetFunction.Max 函数找到的 - 因此无需对工作表数据进行任何操作即可获得答案：

Option Explicit

Sub Test()

    MsgBox ExtractMaxDate(Sheet1.Range("A1"))

End Sub

Function ExtractMaxDate(str As String) As Date

    Dim objRegex As Object 'RegExp
    Dim objMatches As Object 'MatchCollection
    Dim varDates() As Long
    Dim i As Long
    Dim strMaxDate As String

    Set objRegex = CreateObject("VBScript.RegExp")
    With objRegex
        .Global = True
        .IgnoreCase = True
        ' will not match days > 31 or strings that are not months or year 0000
        .Pattern = "((0[1-9]|1[0-9]|2[0-9]|3[0-1])(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)([0-9][0-9][0-9][1-9]))"
    End With

    ' run regex
    Set objMatches = objRegex.Execute(str)

    ' any matches ?
    If objMatches.Count > 0 Then
        ' re-dim the array to number of matches
        ReDim varDates(0 To objMatches.Count - 1)
        For i = 0 To objMatches.Count - 1
            ' get date as yyyy-mm-dd and use CDate and store in array of Long
            varDates(i) = CDate(objMatches(i).SubMatches(3) & _
                "-" & objMatches(i).SubMatches(2) & _
                "-" & objMatches(i).SubMatches(1))
        Next i
        ' get the max date out of the matches
        strMaxDate = CDate(WorksheetFunction.Max(varDates))
    Else
        ' no matches
        strMaxDate = 0
    End If

    ExtractMaxDate = strMaxDate

End Function

Answer 2

按照我在您之前的帖子Link 上的回答，找到下面的代码：

Option Explicit

Sub ExtractDates()

Dim Reg1 As Object
Dim RegMatches As Variant
Dim Match As Variant
Dim i As Long

Dim dDay As Long
Dim dYear As Long
Dim dMon As String
Dim MaxDate As Date

Set Reg1 = CreateObject("VBScript.RegExp")
With Reg1
    .Global = True
    .IgnoreCase = True
    .Pattern = "(\d{2}[a-zA-Z]{3}\d{4})" ' Match any set of 2 digits 3 alpha and 4 digits
End With

Set RegMatches = Reg1.Execute(Range("A1").Value)

i = 1
If RegMatches.Count >= 1 Then ' make sure there is at least 1 match
    For Each Match In RegMatches
        dDay = Left(Match, 2)
        dYear = Mid(Match, 6, 4)
        dMon = Mid(Match, 3, 3)

        On Error Resume Next
        If Not IsError(DateValue(dDay & "-" & dMon & "-" & dYear)) Then '<-- check if string has a valid date value
            If Err.Number <> 0 Then
            Else
                Range("B" & i).Value = DateValue(dDay & "-" & dMon & "-" & dYear) ' <-- have the date (as date format) in column B
                i = i + 1
            End If
        End If
        On Error GoTo 0
    Next Match
End If
MaxDate = WorksheetFunction.Max(Range("B1:B" & i - 1))

MsgBox "Maximum valid date value in string is " & MaxDate

End Sub

您的字符串、提取日期和显示最大日期的 MsgBox 的屏幕截图：

Answer 3

对我之前的代码的解决方案稍作修改：

Sub main()
    Dim arr As Variant

    With Range("A1")
        arr = Split(.Value, " ")
        With .Resize(UBound(arr) + 1)
            .Value = Application.Transpose(arr)
            .SpecialCells(xlCellTypeConstants, xlTextValues).Delete xlUp
            .cells(1, 1) = WorksheetFunction.Max(.cells)
            .Offset(1).Resize(.Rows.Count - 1).ClearContents
        End With
    End With
End Sub

Answer 4

@user3598756 的回答让我想到了可以将字符串评估为数组（未测试）：

MsgBox Evaluate("TEXT(MAX(IFERROR(--""" & Replace([A1], " ", """,),IFERROR(--""") & """,)),""ddmmmyyyy"")")