使用当前年份而不是时间戳的文本到列(日期)

Text to Column (Date) using current year instead of the timestamp

我使用文本到列作为 VBA 宏的一部分,将时间戳分隔到另外 2 个列中。当我将 B 列格式化为 dd/mm/yyyy 时,它使用当前的 2020 年而不是 2019 年。有没有办法调整我的宏以从原始时间戳中提取年份,或者从 C 列中提取年份一次 Text to Columns完成了吗?

Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("A5"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 3), Array(2, 3), Array(3, 3)), TrailingMinusNumbers:=True
    Range("B5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "dd/mm/yyyy;@"
    Selection.TextToColumns Destination:=Range("B5"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 8), TrailingMinusNumbers:=True

根据屏幕截图中的数据,您可以使用以下函数拆分时间戳

 Function convertTimestamp(ByVal inp As String) As Variant

    Dim sDate As String, sTime As String, sTimezone As String, sDay As String
    Dim v As Variant

    v = Split(Replace(inp, ",", ""), " ")
    sDate = DateValue(v(2) & " " & v(1) & " " & v(3))

    sTime = TimeValue(v(4) & " " & v(5))
    sTimezone = v(6)
    sDay = v(0)

    ReDim v(1 To 4)
    v(1) = sDay
    v(2) = CDate(sDate)
    v(3) = sTime
    v(4) = sTimezone

    convertTimestamp = v

End Function

PS根据Scott出色的字符串分割方法调整了函数

您可以在工作表本身中使用此函数(作为数组函数!),也可以使用以下代码将第 5 行拆分为第 8 行,如您的屏幕截图所示

Sub TimeStampToCol()

    Dim rg As Range
    Set rg = Range("A5:A8")

    Dim vDat As Variant
    vDat = WorksheetFunction.Transpose(rg)

    Dim rDat As Variant
    ReDim rDat(1 To 4, 1 To 4)

    Dim i As Long, v As Variant, j As Long
    For i = LBound(vDat) To UBound(vDat)
        v = convertTimestamp(vDat(i))
        For j = 1 To 4
            rDat(i, j) = v(j)
        Next j
    Next i

    Set rg = Range("B5:E8")
    rg.Value = rDat

End Sub

用作数组公式

这使用数组:

Sub mydatesplit()
    With ActiveSheet
        Dim arr As Variant
        arr = .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Value

        Dim outArr() As Variant
        ReDim outArr(1 To UBound(arr, 1), 1 To 3)

        Dim i As Long
        For i = 1 To UBound(arr, 1)
            Dim spltStr() As String
            spltStr = Split(Replace(arr(i, 1), ",", ""), " ")
            If UBound(spltStr) >= 5 Then
                outArr(i, 1) = spltStr(0)
                outArr(i, 2) = DateValue(spltStr(2) & " " & spltStr(1) & " " & spltStr(3))
                outArr(i, 3) = TimeValue(spltStr(4) & " " & spltStr(5))
            End If
        Next i

        .Range("B5").Resize(UBound(outArr, 1), UBound(outArr, 2)).Value = outArr
    End With
End Sub

运行之后:


BTW 动态数组公式新引入 Excel 最新订阅可以使用相当简单的公式:

日期:

=--TEXTJOIN(" ",TRUE,INDEX(TRIM(MID(SUBSTITUTE(SUBSTITUTE(A5,",","")," ",REPT(" ",999)),(ROW(:)-1)*999+1,999)),{3,2,4}))

时间

=--TEXTJOIN(" ",TRUE,INDEX(TRIM(MID(SUBSTITUTE(SUBSTITUTE(A5,",","")," ",REPT(" ",999)),(ROW(:)-1)*999+1,999)),{5,6}))