O analisador de data de macro do Excel não pode manipular dias de dígito único

Question

De perguntas anteriores sobre este e outros sites, recebi uma função que pode analisar e localizar datas em cadeias de texto ou células. Aqui está a função:

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

Isso é então chamado referenciando um endereço de célula:

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

Eu posso formatar a saída usando Format(dateWork, "mmddyy") ou similar.

No caso acima, dado um conteúdo de célula de 8/31/2011 , a string 08312011 é retornada.

Começando com as datas de conteúdo da célula com um dia de dígito único (isto é, no início do mês), a função começou a retornar os dois primeiros dígitos do ano em vez dos dois primeiros dígitos. De repente, as datas começaram a parecer que estavam em 2020, não em 2011.

Eu pude testar isso usando folhas de dados de entrada idênticas, em que datas até e incluindo 8/31/2011 foram retornadas corretamente e datas começando com 9/1/2011 e continuando todas retornando "20" como o ano.

Onde esta função está quebrando?

ATUALIZAÇÃO DE ATUALIZAÇÃO para perguntas:

Eu uso essa função em várias macros que atuam em dados exportados de uma ferramenta de geração de relatórios (Business Objects). É possível editar manualmente a data nos arquivos de entrada, mas isso acaba com o propósito das macros e, portanto, não deve ser considerado uma opção.

A função GetDate () pode ser chamada para encontrar datas em qualquer string. As strings podem ser apenas a data em qualquer um dos vários formatos, ou podem ser combinações de texto e data, como "Totais a partir de 13/9/1977".

Eu apreciaria sua simplificação ou edições para a função, desde que retenha as habilidades descritas acima.

    

Answer 1

Seu Mid(strInput, intPosition, intDateLength) não está funcionando para você. Para 1/9/2011, você está correspondendo a DateFormat(6) = "*#[-/]#[-/]##*" . Então, Mid(strInput, intPosition, intDateLength) = Mid("9/1/2011", 1, 6) e devolve "9/1/20" em vez de "9/1/2011".

com base no seu exemplo acima, acho que você precisa adicionar mais dois padrões para cobrir todas as combinações de 1 e 2 dígitos meses / dias & 2 e 4 dígitos anos. A ordem é importante porque você deseja corresponder os primeiros quatro dígitos anos (observando que o motivo de você ter um problema é que # / # / ## corresponde a 1/9/2011 quando, na verdade, você só quer para coincidir com 01/09/11. Então a alteração do código é algo como o abaixo.Eu não exaustivamente testado com todos os formatos de data, mas parece OK.

intMaxFormat = 8
ReDim DateFormat(1 To intMaxFormat)

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

    

Answer 2

Eu escrevi uma macro mais curta que deve fazer o que você quer. Ele divide a string em um array pelo caractere de espaço. A macro, em seguida, executa a matriz procurando a data. Se houver caracteres extras anexados à data, ele falhará. No entanto, se a data for sua "própria palavra", separada por espaços nas duas extremidades, ela funcionará perfeitamente. Dependendo de suas necessidades, talvez precise ser modificado um pouco.

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