[英]Trying to convert iso 8601 datetime into real date time in excel vial vba
我发现如何通过公式转换这个2020-10-06T16:19:00
是:
=DATEVALUE(MID(A1,1,10))+TIMEVALUE(MID(A1,12,8))
但我试图通过 VBA 来做到这一点,以将其应用于整列。 这是VBA 示例
我试过这个:
Public Function UTCToLocalTime(dteTime As Date) As Date
Dim infile As FILETIME
Dim outfile As FILETIME
Dim insys As SYSTEMTIME
Dim outsys As SYSTEMTIME
insys.wYear = CInt(Year(dteTime))
insys.wMonth = CInt(Month(dteTime))
insys.wDay = CInt(Day(dteTime))
insys.wHour = CInt(Hour(dteTime))
insys.wMinute = CInt(Minute(dteTime))
insys.wSecond = CInt(Second(dteTime))
Call SystemTimeToFileTime(insys, infile)
Call FileTimeToLocalFileTime(infile, outfile)
Call FileTimeToSystemTime(outfile, outsys)
UTCToLocalTime = CDate(outsys.wDay & "/" & _
outsys.wMonth & "/" & _
outsys.wYear & " " & _
outsys.wHour & ":" & _
outsys.wMinute & ":" & _
outsys.wSecond)
End Function
但收到一个错误:您的帮助将不胜感激。
Sub ChangeFormat()
Dim sh As Worksheet
Dim Tuming As String
Dim LastRow As Long
Set ws = Sheet43
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("C2:C" & LastRow).NumberFormat = "m/d/yyyy h:mm"
Tuming = "2020-10-06T16:19:00"
Debug.Print UTCToLocalTime(Tuming)
End Sub
最安全的方法是将字符串分成几部分,然后使用DateSerial
和TimeSerial
方法将其组合在一起。
Option Explicit
Public Sub example()
Range("A1").Value = ConvertISO8601StringToDate("2020-10-06T16:19:00")
Range("A1").NumberFormat = "m/d/yyyy h:mm"
End Sub
Public Function ConvertISO8601StringToDate(ByVal InputString As String) As Date
Dim DatePart As Date
DatePart = DateSerial(Left$(InputString, 4), Mid$(InputString, 6, 2), Mid$(InputString, 9, 2))
Dim TimePart As Date
TimePart = TimeSerial(Mid$(InputString, 12, 2), Mid$(InputString, 15, 2), Mid$(InputString, 18, 2))
ConvertISO8601StringToDate = DatePart + TimePart
End Function
要转换整个范围,请使用数组进行快速处理:
Public Sub ConvertRange()
Dim RangeToConvert As Range ' define range
Set RangeToConvert = ThisWorkbook.Worksheets("Sheet1").Range("A1:A13")
Dim DataArray() As Variant ' convert range into array for fast processing
DataArray = RangeToConvert.Value
' loop throug array data
Dim iRow As Long
For iRow = LBound(DataArray, 1) To UBound(DataArray, 1)
Dim iCol As Long
For iCol = LBound(DataArray, 2) To UBound(DataArray, 2)
' convert iso8601 conform strings and leave the rest unchanged
Dim DateVal As Date
On Error Resume Next
DateVal = ConvertISO8601StringToDate(DataArray(iRow, iCol))
If Err.Number = 0 Then ' only convert iso8601 strings
DataArray(iRow, iCol) = DateVal
End If
On Error GoTo 0
Next iCol
Next iRow
' write array data back to sheet
RangeToConvert.Value = DataArray
End Sub
更强大的 RegEx 功能,可以转换所有 ISO8601 定义的格式:
时区时间的输出转换为 UTC+00:00。 因此,如果需要在任何其他区域中,则需要在此之后进行转换。 例如进入通勤者时区。
对于没有指定日期(如YYYY
、 YYYY-MM
或YYYY-Www
的日期,始终假定该时间段的第一天。 因此,例如2004-W28
将该周的开始日期设为2004-07-05
以获得该周的结束时间,您只需在开始处添加+6
。 此外, 2004-07
将假定为2004-07-01
月初。 并且年份2004
将转换为日期2004-01-01
。
Public Function ConvDateTime(ByVal InVal As String) As Date
Dim SplitDateTime() As String
SplitDateTime = Split(InVal, "T")
ConvDateTime = ConvDate(SplitDateTime(0)) + ConvTime(SplitDateTime(1))
End Function
Public Function ConvDate(ByVal InVal As String) As Date
Dim RetVal As Variant
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.MultiLine = True
.IgnoreCase = False
End With
RegEx.Pattern = "^(\d{4})-?(\d{2})?-?(\d{2})?$|^(\d{4})-?W(\d{2})?-?(\d)?$|^(\d{4})-?(\d{3})$"
Dim Match As Object
Set Match = RegEx.Execute(InVal)
If Match.Count <> 1 Then Exit Function
With Match(0)
If Not IsEmpty(.SubMatches(0)) Then
'YYYY-MM-DD
If IsEmpty(.SubMatches(1)) Then 'YYYY
RetVal = DateSerial(CInt(.SubMatches(0)), 1, 1)
ElseIf IsEmpty(.SubMatches(2)) Then 'YYYY-MM
RetVal = DateSerial(CInt(.SubMatches(0)), CInt(.SubMatches(1)), 1)
Else 'YYYY-MM-DD
RetVal = DateSerial(CInt(.SubMatches(0)), CInt(.SubMatches(1)), CInt(.SubMatches(2)))
End If
ElseIf Not IsEmpty(.SubMatches(3)) Then
'YYYY-Www-D
RetVal = DateSerial(CInt(.SubMatches(3)), 1, 4) '4th of jan is always week 1
RetVal = RetVal - Weekday(RetVal, 2) 'subtract the weekday number of 4th of jan
RetVal = RetVal + 7 * (CInt(.SubMatches(4)) - 1) 'add 7 times the (weeknumber - 1)
If IsEmpty(.SubMatches(5)) Then 'YYYY-Www
RetVal = RetVal + 1 'choose monday of that week
Else 'YYYY-Www-D
RetVal = RetVal + CInt(.SubMatches(5)) 'choose day of that week 1-7 monday to sunday
End If
Else
'YYYY-DDD
RetVal = DateSerial(CInt(.SubMatches(6)), 1, 1) + CInt(.SubMatches(7)) - 1
End If
End With
ConvDate = RetVal
End Function
Public Function ConvTime(ByVal InVal As String) As Date
Dim RetVal As Variant
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.MultiLine = False
.IgnoreCase = False
End With
RegEx.Pattern = "^(\d{2}):?(\d{2})?:?(\d{2})?(\+|\-|Z)?(\d{2})?:?(\d{2})?$|^(\d{2}):(\d{2}):(\d{2}\.?\,?\d{4})?(\+|\-|Z)?(\d{2})?:?(\d{2})?$"
Dim Match As Object
Set Match = RegEx.Execute(InVal)
If Match.Count <> 1 Then Exit Function
With Match(0)
If Not IsEmpty(.SubMatches(0)) Then
'hh:mm:ss
If IsEmpty(.SubMatches(1)) Then 'hh
RetVal = TimeSerial(CInt(.SubMatches(0)), 0, 0)
ElseIf IsEmpty(.SubMatches(2)) Then 'hh:mm
RetVal = TimeSerial(CInt(.SubMatches(0)), CInt(.SubMatches(1)), 0)
Else 'hh:mm:ss
RetVal = TimeSerial(CInt(.SubMatches(0)), CInt(.SubMatches(1)), CInt(.SubMatches(2)))
End If
If Not IsEmpty(.SubMatches(3)) Then
If Not .SubMatches(3) = "Z" Then
If Not IsEmpty(.SubMatches(4)) Then
RetVal = DateAdd("h", -1& * CDbl(.SubMatches(3) & .SubMatches(4)), RetVal)
End If
If Not IsEmpty(.SubMatches(5)) Then
RetVal = DateAdd("n", -1& * CDbl(.SubMatches(3) & .SubMatches(5)), RetVal)
End If
End If
End If
Else
'hh:mm:ss,f
Dim Milliseconds As String
Milliseconds = .SubMatches(8)
Milliseconds = Replace$(Milliseconds, ",", Application.DecimalSeparator)
Milliseconds = Replace$(Milliseconds, ".", Application.DecimalSeparator)
RetVal = TimeSerial(CInt(.SubMatches(6)), CInt(.SubMatches(7)), 0)
RetVal = RetVal + (CDbl(Milliseconds) / 60 / 60 / 24) ' TimeSerial does not support milliseconds
End If
End With
ConvTime = RetVal
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.