是否有另一种方法可以在VBA中获得dateTime的第二次出现？

Question

如何使用VBA搜索字符串中DateTime的最后一次出现？

例如，给出以下示例：

在下面的示例中，在A列中，有带有DateTime标记的注释。我需要获取dateTime的最后一次出现。如果仅注释仅包含1个日期时间，那么我需要获取。预期的输出在B列中。

我试图获取dateTime，但它正在第一次出现。请参阅下面的代码：

Sub test()
    For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(x, 2).Value = Left(Cells(x, 1).Value, 19)
        Cells(x, 2).Select
        Selection.NumberFormat = "yyyy-mm-dd hh:mm:ss"
    Next x
End Sub

Answer 1

我相信这应该可以满足您的需求。您可以在拆分单元格的内容后向后循环，并在找到第一个有效日期时退出。

Option Explicit
Private Function GetLastDate(TextRange As Range) As String
    Dim textToParse         As String: textToParse = TextRange.Value
    Dim textArray           As Variant: textArray = Split(textToParse, vbLf)
    Dim possibleDate        As Variant
    Dim i                   As Long
    Dim j                   As Long
    Const textToSplit = " - "

    'Loop backwards
    For i = UBound(textArray) To LBound(textArray) Step -1
        'A Dash Exists
        If (InStr(1, textArray(i), textToSplit) > 0) Then
            possibleDate = Split(textArray(i), textToSplit)

            'Loop forwards
            For j = LBound(possibleDate) To UBound(possibleDate)
                'If it is a date exit
                If IsDate(Trim(possibleDate(j))) Then
                    GetLastDate = Trim(possibleDate(j))
                    Exit Function
                End If
            Next

        End If
    Next

End Function

Sub Example()
    Dim rng As Range: Set rng = ThisWorkbook.Sheets("Sheet1").Range("a1")
    Debug.Print "the last date is: " & GetLastDate(rng)
End Sub

Answer 2

这也可以使用公式来完成，例如，我在A1中有以下内容

"01/02/2019 testing

04/05/19 test stage


05/09/2019 test3"

并使用以下公式

=MID(A1,FIND("@",SUBSTITUTE(A1,"/","@",LEN(A1)-LEN(SUBSTITUTE(A1,"/",""))-1))-2,10)

我知道

05/09/2019

希望这会有所帮助。