如何从包含多个日期值和不同字符的字符串中获取MAX日期?
字符串示例:
11AUG2016更改gggqqq2i8yj 29SEP2016移除tyijdg298 30SEP2016添加,mkdjenb200 03OCT2016 zzxxddd4423 04OCT2016 jioi == ++ - 234jju 24OCT2016更新tuiomahdkj 10JAN2017更新ZZZZ T4123III 13JAN2017更新jukalzzz123 20JAN2017 iiiwwwaazz678uuh
答案 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]))
这将过滤掉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
答案 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:
答案 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"")")