1

Из предыдущих вопросов на этом и других сайтах мне была дана функция, которая может анализировать и находить даты в текстовых строках или ячейках. Вот функция:

Function GetDate(strInput As String) As Date

    Dim DateFormat() As String
    Dim intDateLength As Integer
    Dim intMaxFormat As Integer
    Dim intFrmtCtr As Integer
    Dim intPosition As Integer

    intMaxFormat = 6
    ReDim DateFormat(1 To intMaxFormat)

    DateFormat(1) = "*##[-/]##[/-]####*"
    DateFormat(2) = "*#[-/]##[-/]####*"
    DateFormat(3) = "*##[-/]#[-/]####*"
    DateFormat(4) = "*##[-/]##[-/]##*"
    DateFormat(5) = "*#[-/]##[-/]##*"
    DateFormat(6) = "*#[-/]#[-/]##*"

    GetDate = Now

    For intFrmtCtr = 1 To intMaxFormat
        If strInput Like DateFormat(intFrmtCtr) Then
            intDateLength = Len(DateFormat(intFrmtCtr)) - 8
            strInput = Replace(strInput, " ", "")

            For intPosition = 1 To Len(strInput)
                If Mid(strInput, intPosition, intDateLength) Like DateFormat(intFrmtCtr) Then
                    GetDate = DateValue(Mid(strInput, intPosition, intDateLength))
                    Exit Function
                End If
            Next intPosition
        End If
    Next intFrmtCtr

End Function

Затем это вызывается путем ссылки на адрес ячейки:

'Gets date from cell A2
    Range("A2").Select
    dateWork = GetDate(Selection)

Затем я могу отформатировать вывод с помощью Format(dateWork, "mmddyy") или аналогичным.

В приведенном выше случае, учитывая содержимое ячейки от 8/31/2011 строка 08312011 .

Однако, начиная с дат содержимого ячеек с одним числом дня (т. Е. В начале месяца), функция начала возвращать первые две цифры года вместо вторых двух цифр. Внезапно даты начали выглядеть так, как будто они были в 2020 году, а не в 2011 году.

Я смог проверить это, используя идентичные входные таблицы с данными, где даты до 8/31/2011 были возвращены правильно, а даты, начинающиеся с 9/1/2011 и продолжающиеся, возвращают "20" как год.

Где эта функция ломается?

ОБНОВЛЕНИЕ уточнения по вопросам:

Я использую эту функцию в нескольких макросах, действующих на данные, экспортированные из инструмента генерации отчетов (Business Objects). Можно вручную редактировать дату во входных файлах, но это скорее противоречит назначению макросов и поэтому не должно рассматриваться как вариант.

Функция GetDate() может быть вызвана для поиска дат в любой строке. Строки могут быть просто датой в любом из различных форматов или могут представлять собой комбинации текста и даты, например «Итоги по состоянию на 13.09.1977».

Буду признателен за ваше упрощение или внесение изменений в функцию, если она сохраняет способности, изложенные выше.

2 ответа2

3

Ваш Mid(strInput, intPosition, intDateLength) не работает для вас. На 01.09.2011 вы соответствуете DateFormat(6) = "*#[-/]#[-/]##*" . So Mid(strInput, intPosition, intDateLength) = Mid("9/1/2011", 1, 6) и возвращает «01.09.20», а не «01.09.2011».

основываясь на вашем примере выше, я думаю, что вам нужно добавить еще 2 шаблона, чтобы охватить все комбинации из 1 и 2 цифр месяцев / дней и 2 и 4 цифр лет. Порядок важен, потому что вы хотите сначала сопоставить 4-значные годы (отметив, что причина, по которой у вас возникла проблема, состоит в том, что # / # / ## соответствует 01.09.2011, когда на самом деле вы хотите, чтобы он совпадал только с 9.09.11 , Таким образом, изменение кода выглядит примерно так: Я не исчерпывающе проверил это со всеми форматами даты, но это кажется хорошо.

intMaxFormat = 8
ReDim DateFormat(1 To intMaxFormat)

DateFormat(1) = "*##[-/]##[/-]####*"
DateFormat(2) = "*#[-/]##[-/]####*"
DateFormat(3) = "*##[-/]#[-/]####*"
DateFormat(4) = "*#[-/]#[-/]####*"
DateFormat(5) = "*##[-/]##[-/]##*"
DateFormat(6) = "*##[-/]#[-/]##*"
DateFormat(7) = "*#[-/]##[-/]##*"
DateFormat(8) = "*#[-/]#[-/]##*"
0

Я написал более короткий макрос, который должен делать то, что вы хотите. Он разбивает строку на массив по пробелу. Затем макрос проходит по массиву в поисках даты. Если к дате добавлены дополнительные символы, произойдет сбой. Однако, если дата - это ее "собственное слово", разделенное на обоих концах интервалами, она работает отлично. В зависимости от ваших потребностей, возможно, потребуется немного изменить.

Function GetDate(strInput As String) As Date

 Dim strDate() As String, i As Long

  strDate = Split(strInput, " ")

 For i = 0 To UBound(strDate) - 1
    If Right(strDate(i), 1) = "." Then strDate(i) = Left(strDate(i), Len(strDate(i)) - 1)
    If IsDate(strDate(i)) Then
       GetDate = strDate(i)
       Exit For
    End If
 Next i

End Function

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .