VBA:字符串的最大日期

时间:2017-02-27 01:03:04

标签: string vba excel-vba date max

如何从包含多个日期值和不同字符的字符串中获取MAX日期?

字符串示例:

  

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

4 个答案:

答案 0 :(得分:2)

只是为了扭曲,我更喜欢使用这个正则表达式:

((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]))

这将过滤掉00FOO99DEX等字符串以及日期和月份的字符串。如果年份为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

答案 1 :(得分:1)

按照我之前在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:

enter image description here

答案 2 :(得分:1)

对我之前代码的解决方案进行了少量修改:

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

答案 3 :(得分:0)

@ user3598756的回答让我知道该字符串可以被评估为一个数组(未经测试):

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