使用单独的格式参数(如 TO_DATE、DateTime.ParseExact)在 Excel 中将字符串转换为日期时间?

Ali*_*Tor -1 excel datetime vba type-conversion to-date

是否有使用 Excel 中作为参数给出的日期时间格式将字符串转换为日期时间的函数?

您可以在不同平台上想象以下类似的功能:

PLSQL: TO_DATE("20191301","YYYYDDMM")
C#: DateTime.ParseExact("20191301","YYYYDDMM", null)
Run Code Online (Sandbox Code Playgroud)

Asg*_*ger 5

Here is an attempt for a user-defined worksheet function:

  • Function returns datetime value
  • Supported format-string parts: yyyy, yy, mmm, MM, dd, hh, mm, ss
  • am, a.m., a. m., pm, p.m., p. m. and their uppercases are all equivalent
  • Only MM (month) and mm (minute) are case sensitive,
    MMM or mmm equals to Jan, Feb, ...
  • 2-digit years below 80 are 20xx, 80 or above are 19xx
  • Format-string must have the same length as the source string,
    otherwise returns #N/A error
  • Filling characters can be blank, colon, double colon or else

Examples: VBA 中的 TO_DATE DateTime.ParseExact 示例

EDIT:

Public Function TO_DATE(ByRef src As String, ByRef frmt As String) As Variant
    Dim y As Long, m As Long, d As Long, h As Long, min As Long, s As Long
    Dim am As Boolean, pm As Boolean
    Dim pos As Long

    If Len(src) <> Len(frmt) Then
        TO_DATE = CVErr(xlErrNA)  ' #N/A error
        Exit Function
    End If

    pos = InStr(1, frmt, "yyyy", vbTextCompare)
    If pos > 0 Then
        y = Val(Mid(src, pos, 4))
    Else: pos = InStr(1, frmt, "yy", vbTextCompare)
        If pos > 0 Then
            y = Val(Mid(src, pos, 2))
            If y < 80 Then y = y + 2000 Else y = y + 1900
        End If
    End If

    pos = InStr(1, frmt, "mmm", vbTextCompare)
    If pos > 0 Then
        m = month(DateValue("01 " & (Mid(src, pos, 3)) & " 2000"))
    Else: pos = InStr(1, frmt, "MM", vbBinaryCompare)
        If pos > 0 Then m = Val(Mid(src, pos, 2))
    End If

    pos = InStr(1, frmt, "dd", vbTextCompare)
    If pos > 0 Then d = Val(Mid(src, pos, 2))

    pos = InStr(1, frmt, "hh", vbTextCompare)
    If pos > 0 Then h = Val(Mid(src, pos, 2))
    If InStr(1, src, "am", vbTextCompare) > 0 Then am = True
    If InStr(1, src, "a.m.", vbTextCompare) > 0 Then am = True
    If InStr(1, src, "a. m.", vbTextCompare) > 0 Then am = True
    If InStr(1, src, "pm", vbTextCompare) > 0 Then pm = True
    If InStr(1, src, "p.m.", vbTextCompare) > 0 Then pm = True
    If InStr(1, src, "p. m.", vbTextCompare) > 0 Then pm = True
    If am And h = 12 Then h = 0
    If pm And h <> 12 Then h = h + 12

    pos = InStr(1, frmt, "mm", vbBinaryCompare)
    If pos > 0 Then min = Val(Mid(src, pos, 2))

    pos = InStr(1, frmt, "ss", vbTextCompare)
    If pos > 0 Then s = Val(Mid(src, pos, 2))

    TO_DATE = DateSerial(y, m, d) + TimeSerial(h, min, s)
End Function
Run Code Online (Sandbox Code Playgroud)