Как очистить строку, чтобы соответствовать дате

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

Ниже будет найти дату, если она есть, но она не может быть дата вы хотите:

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 недели Ending 04/10/15

Он находит подстроку:

04/1

первый - которая является действительной датой !!

Вы хотите, чтобы ВСЕ подходящие даты в строке ???

EDIT # 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

Это будет соответствовать широкому диапазону форматов даты

Надеюсь, что это поможет

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 

Выход

EDIT

Вы также можете использовать эту функцию в качестве функции 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