VBA - дата анализа из текстовой строки произвольной формы

Question

Я пытаюсь проанализировать чистые целевые ДАТЫ из ячеек, населенных свободной строкой ТЕКСТА.

т.е. 2019 EOD "

Как вы можете видеть, не существует четкого стандарта для положения даты в строке, что делает формулы LEFT или RIGHT бесполезными.

Я попытался использовать функцию VBA, которую янайдено, которое по существу разбивает строку на части на основе пробелов в строке;однако это не работает.

Public Function GetDate(ResNotes As String) As Date

    Dim TarDate As Variant
    Dim part As Variant

    TarDate = Split(ResNotes, " ")

    For Each part In ResNotes
        If IsDate(part) = True Then
           GetDate = part
           Exit Function
        End If
    Next

    GetDate = "1/1/2001"
End Function

Я имею в виду ячейки с текстовыми строками как «ResNotes», сокращение от «Resolution Notes», которое является заголовком столбца

«TarDate» относится к «целевой дате», которую я пытаюсь проанализировать

Результат пользовательской функции GETDATE в Excel дает мне #NAME? ошибка.

Я ожидал, что результат даст мне что-то вроде "30.10.2009"

Answer 1

Если вам не нужен VBA для какой-либо другой части вашего проекта, это также можно сделать с помощью формул рабочего листа:

=AGGREGATE(15,6,DATEVALUE(MID(SUBSTITUTE(A1," ",REPT(" ",99)),seq_99,99)),1)

, где seq_99 - именованная формула и относится к:

=IF(ROW($A$1:INDEX($A:$A,255,1))=1,1,(ROW($A$1:INDEX($A:$A,255,1))-1)*99)

*seq_99 создает массив чисел {1;99;198;297;396;495;...

Отформатируйте ячейку с формулой как Дата некоторого типа.

Если даты отсутствуют, будет возвращена ошибка, которую вы можете оставить или обернуть функцию в IFERROR(your_formula,your_error_message)

Алгоритм

• Разделить ячейку на пробелы
  • Заменить каждый пробел на 99 пробелов
  • Используя функцию MID, вернуть массив подстрок длиной 99 символов
• Примените функцию DATEVALUE, которая будет возвращать либо ошибку (если подстрока не является датой), либо серийный номер даты.
• Поскольку даты в Excel являются серийными номерами с 1/1 /1900, мы можем использовать функцию AGGREGATE, чтобы выбрать значение и игнорировать ошибки.

Answer 2

Если вы получаете #NAME, тогда код не сохраняется в общем модуле. Это НЕ должно быть в модуле рабочего листа или модуле ThisWorkbook.

Также в коде есть несколько ошибок. Split возвращает массив String. И поскольку IsDate возвращает TRUE/FALSE, = True не требуется.

Согласно @ MathieuGuindon мы можем изменить строку на дату в коде, если она найдена, и вернуть ошибку, если нет,Для этого нам нужно, чтобы возврат был вариантом.

Public Function GetDate(ResNotes As String)

    Dim TarDate() As String
    Dim part As Variant

    TarDate = Split(ResNotes, " ")

    For Each part In TarDate
        If IsDate(part) Then
           GetDate = CDate(part)
           Exit Function
        End If
    Next

    GetDate = "1/1/2001"
    'Instead of a hard coded date, one can return an error, just use the next line instead
    'GetDate =CVErr(xlErrValue)
End Function

Answer 3

Подход, изолирующий строку даты с помощью функции Filter

Просто для забавы другой подход, демонстрирующий использование функции Filter в сочетании с Split для выделения строка даты и разделить ее на токены даты на втором шаге;наконец, эти токены преобразованы на сегодняшний день с использованием DateSerial:

Function getDat(rng As Range, Optional ByVal tmp = " ") As Variant
  If rng.Cells.count > 1 Then Set rng = rng.Cells(1, 1)             ' allow only one cell ranges
  If Len(rng.value) = 0 Then getDat = vbNullString: Exit Function   ' escape empty cells
' [1] analyze cell value; omitted year tokens default to current year
'     (valid date strings must include at least one slash, "11/" would be interpreted as Nov 1st)
  tmp = Filter(Split(rng.Value2, " "), Match:="/", include:=True)   ' isolate Date string
  tmp = Split(Join(tmp, "") & "/" & Year(Now), "/")                 ' split Date tokens
' [2] return date
  Const M% = 0, D% = 1, Y& = 2                                      ' order of date tokens
  getDat = VBA.DateSerial(Val(tmp(Y)), Val(tmp(M)), _
                          IIf(tmp(D) = vbNullString, 1, Val(tmp(D))))
End Function