如何刷新字符串以匹配日期

Question

因此，我构建了一个用于验证的工作簿，并将其他工作簿/报告集发布到另一个位置。部分过程是让用户在单元格中输入日期值，并在用户列出的报告中进行检查。

日期格式无关紧要，因为我在验证函数中进行日期类型到日期类型比较。

基本上：

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

另一种常见情况是日期始终位于比较单元格中字符串的末尾。

示例：

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

无论用户输入验证单元格的格式如何，我都会从右边开始剥离，直到isdate弹出为真。

我知道我在这个设置中很幸运，日期总是在最后。我现在遇到两个无效的实例。

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

在第一个中，括号中断right()剥离。在第二个，日期是在中间。日期值的格式因报告而异，因此我无法执行instr(1, String, cstr(UserVal))来完成检查。日期的位置也不是固定的，因为它可能位于字符串末尾，开头或任何位置。

简单的方法是，有一种简单的方法来扫描字符串的指定日期值，与格式无关吗？

Answer 1

这是我的微弱尝试：D

这将匹配各种日期格式

希望这有帮助

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

Answer 2

以下内容会找到日期（如果有），但可能不是您想要的日期：

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

该例程生成一个字符串的所有正确排序的子字符串，并测试每个字符串 IsDate（）

问题在于：

当前52周结束04/10/15

找到子字符串：

<强> 04/1

首先 - 这是一个有效的日期!!

你想要字符串???

中的所有有效日期

修改＃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