如何擦洗一个string以匹配date

所以我build立了一个validation工作簿，并将其他工作簿/报告集发布到另一个位置。 过程的一部分是用户在单元格中inputdate值，并在用户列出的报告中检查。

date格式不重要，因为我正在做datetypesdatetypes比较在我的validationfunction。

基本上：

if CDate(UserVal) = CDate(ValFromString) then 'do stuff end if 

另一种常见情况是date一直在比较单元格的string末尾。

例：

 Current 52 Weeks Ending 04/10/15 Cur 52 Weeks Apr 4, 2015 Current 52 WE 4-Apr-15 

无论用户input到validation单元格的格式如何，我都会继续从右边剥离，直到isdatepopup。

我知道我很幸运，date总是在最后。 我现在遇到了两个不起作用的实例。

 CURRENT 12 WEEKS (4 WEEKS ENDING 04/11/15) 4 WE 04/11/2015 Current 12 

首先，括号破坏了我的right()剥离。 第二，date在中间。 date值的格式因报告而instr(1, String, cstr(UserVal)) ，所以我不能做一个instr(1, String, cstr(UserVal))来完成检查。 date的位置也不是一成不变的，因为它可能在结束，开始，或在string中间的任何地方。

短的方式来说，是否有一个简单的方法来扫描string指定的date值，格式不可知？

Answer 1

下面会find一个date，但它可能不是你想要的date：

 Sub INeedADate() Dim st As String, L As Long, i As Long, j As Long st = ActiveCell.Text L = Len(st) For i = 1 To L - 1 For j = 1 To L st2 = Mid(st, i, j) If IsDate(st2) Then MsgBox CDate(st2) Exit Sub End If Next j Next i End Sub 

例程生成一个string的所有正确sorting的子string，并testing每个string的IsDate（）

问题是，对于：

当前52周结束04/10/15

它find子string：

04/1

第一 – 这是一个有效的date！

你想在string内的所有有效date？

编辑＃1：

解决方法是向后运行Mid（）函数的长度部分：

 Sub INeedADate() Dim st As String, L As Long, i As Long, j As Long st = ActiveCell.Text L = Len(st) For i = 1 To L - 1 For j = L To 1 Step -1 st2 = Mid(st, i, j) If IsDate(st2) Then MsgBox CDate(st2) Exit Sub End If Next j Next i End Sub 

Answer 2

这是我的微弱尝试：D

这将匹配各种各样的date格式

希望这可以帮助

 Sub Sample() Dim MyAr(1 To 5) As String, frmt As String Dim FrmtAr, Ret Dim i As Long, j As Long MyAr(1) = "(This 01 has 04/10/15 in it)" MyAr(2) = "This 04/10/2015" MyAr(3) = "4-Apr-15 is a Sample date" MyAr(4) = "(Apr 4, 2015) is another sample date" MyAr(5) = "How about ((Feb 24 2012)) this?" '~~> Various date formats '~~> YYYY (/????) grouped together. Will search for this first frmt = "??/??/????|?/??/????|??/?/????|??-??-????|" frmt = frmt & "?-??-????|??-?-????|??? ?? ????|??? ? ????|" frmt = frmt & "?-???-????|???-??-????|???-?-????|" frmt = frmt & "??? ??, ????|??? ?, ????|" '~~> YY (??) grouped after. Will search for this later frmt = frmt & "??-???-??|?-???-??|??/??/??|?/??/??|??/?/??|" frmt = frmt & "??-??-??|?-??-??|??-?-??|???-??-??|???-?-??|" frmt = frmt & "|??? ?? ??|??? ? ??|??? ??, ??|??? ?, ??|" FrmtAr = Split(frmt, "|") For i = LBound(MyAr) To UBound(MyAr) For j = 0 To UBound(FrmtAr) 'Something like =MID(A1,SEARCH("??/??/??",A1,1),8) Expr = "=MID(" & Chr(34) & MyAr(i) & Chr(34) & ",SEARCH(" & _ Chr(34) & Trim(FrmtAr(j)) & Chr(34) & _ "," & Chr(34) & MyAr(i) & Chr(34) & ",1)," _ & Len(Trim(FrmtAr(j))) & ")" Ret = Application.Evaluate(Expr) If Not IsError(Ret) Then If IsDate(Ret) Then Debug.Print Ret Exit For End If End If Next j Next i End Sub 

产量

编辑

您也可以将其用作Excel函数

将其粘贴到模块中

 Public Function ExtractDate(rng As Range) As String Dim frmt As String Dim FrmtAr, Ret Dim j As Long ExtractDate = "No Date Found" '~~> Various date formats '~~> YYYY (/????) grouped together. Will search for this first frmt = "??/??/????|?/??/????|??/?/????|??-??-????|" frmt = frmt & "?-??-????|??-?-????|??? ?? ????|??? ? ????|" frmt = frmt & "?-???-????|???-??-????|???-?-????|" frmt = frmt & "??? ??, ????|??? ?, ????|" '~~> YY (??) grouped after. Will search for this later frmt = frmt & "??-???-??|?-???-??|??/??/??|?/??/??|??/?/??|" frmt = frmt & "??-??-??|?-??-??|??-?-??|???-??-??|???-?-??|" frmt = frmt & "|??? ?? ??|??? ? ??|??? ??, ??|??? ?, ??|" FrmtAr = Split(frmt, "|") For j = 0 To UBound(FrmtAr) 'Something like =MID(A1,SEARCH("??/??/??",A1,1),8) Expr = "=MID(" & Chr(34) & rng.Value & Chr(34) & ",SEARCH(" & _ Chr(34) & Trim(FrmtAr(j)) & Chr(34) & _ "," & Chr(34) & rng.Value & Chr(34) & ",1)," _ & Len(Trim(FrmtAr(j))) & ")" Ret = Application.Evaluate(Expr) If Not IsError(Ret) Then If IsDate(Ret) Then ExtractDate = Ret Exit For End If End If Next j End Function 

注意 ：我仍然在使用RegEx版本，这个版本比这个短得多…

编辑 ：如所承诺的！ 我相信这让我变得更完美，但是现在我不能在这上面花更多的时间:)

RegEx版本

 Sub Sample() Dim MyAr(1 To 5) As String MyAr(1) = "(This 01 has (04/10/15) in it)" MyAr(2) = "This 04/10/2015" MyAr(3) = "4-Apr-15 is a smaple date" MyAr(4) = "(Apr 4, 2015) is another sample date" MyAr(5) = "How about ((Feb 24 2012)) this?" For i = 1 To 5 Debug.Print DateExtract(MyAr(i)) Next i End Sub Function DateExtract(s As String) As String Dim a As String, b As String, c As String Dim sPattern As String sPattern = "\b(jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)" sPattern = sPattern & "\s(\d\d?),?\s+(\d{2,4})|(\d\d?)[\s-](" sPattern = sPattern & "jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec" sPattern = sPattern & ")[\s-,]\s?(\d{2,4})|(\d\d?)[-/](\d\d?)[-/](\d{2,4})\b" With CreateObject("VBScript.RegExp") .Global = False .IgnoreCase = True .Pattern = sPattern If .Test(s) Then Dim matches Set matches = .Execute(s) With matches(0) a = .SubMatches(0) & .SubMatches(3) & .SubMatches(6) b = .SubMatches(1) & .SubMatches(4) & .SubMatches(7) c = .SubMatches(2) & .SubMatches(5) & .SubMatches(8) DateExtract = a & " " & b & " " & c End With End If End With End Function