我有一个电子表格，在 C 列中包含纪元格式的"上次修改日期"，例如：
1486841495(最早日期为2017年( 1574478516(最新日期为2019年(
C 列有 6,003 行。 我想做的是让脚本获取 C 列中的内容并将其转换为 E 列中的以下格式：MM/DD/YY HH：MM：SS AM/PM。我的结果单元格格式正确，因此显示正确。我在中部时区。
我很少接触编写代码，几个小时以来我一直在尝试拼凑一些东西。
这是我能够获得的最接近的，但它只在一个单元格上运行，我需要它在整个 C 列上运行。谁能帮忙？
Sub CalcDate()
'2017
If Range("C2").Value > 1483250400 And Range("C2").Value < 1489298520 Then
Range("E2:E10").Value = ((Range("C2:E10") - 21600) / 86400) + 25569
ElseIf Range("C2").Value > 1489298520 And Range("C2").Value < 1509858120 Then
Range("E2").Value = ((Range("C2") - 18000) / 86400) + 25569
ElseIf Range("C2").Value > 1509858120 And Range("C2").Value < 1514743199 Then
Range("E2").Value = ((Range("C2") - 21600) / 86400) + 25569
'2018
ElseIf Range("C2").Value > 1514786400 And Range("C2").Value < 1520755200 Then
Range("E2:E10").Value = ((Range("C2:E10") - 21600) / 86400) + 25569
ElseIf Range("C2").Value > 1520755200 And Range("C2").Value < 1541318400 Then
Range("E2").Value = ((Range("C2") - 18000) / 86400) + 25569
ElseIf Range("C2").Value > 1541318400 And Range("C2").Value < 1546279199 Then
Range("E2").Value = ((Range("C2") - 21600) / 86400) + 25569
'2019
ElseIf Range("C2").Value > 1546322400 And Range("C2").Value < 1552204800 Then
Range("E2:E10").Value = ((Range("C2:E10") - 21600) / 86400) + 25569
ElseIf Range("C2").Value > 1552204800 And Range("C2").Value < 1572768000 Then
Range("E2").Value = ((Range("C2") - 18000) / 86400) + 25569
ElseIf Range("C2").Value > 1572768000 And Range("C2").Value < 1577815199 Then
Range("E2").Value = ((Range("C2") - 21600) / 86400) + 25569
End If
End Sub
我认为Tim Williams在问题评论中建议的"=fromUnix(C2("公式可能是解决将所有纪元值转换为UTC的最直接方法。但是，如果目的是学习如何单独使用 VBA 来做到这一点，包括转换为本地时间，下面的代码有望对某人有所帮助。
注意：拥有VBA宏的一个优点是它可以一举写出所有结果，并且避免了在工作簿中添加6,000个新公式的需要。缺点是转换不是动态的，因此纪元值的任何更改都需要再次运行宏。
策略
我们需要一个过程，将纪元值从一列读取到数组中，将数组中的每个值从纪元转换为本地时间，然后将该数组打印到另一列。要执行每个纪元值的转换，我们必须首先将其转换为 UTC，并从 UTC 转换为本地时间。
要进行第二次转换，我们需要依靠一些代码，这些代码改编自 ashleedawg 在将 UTC 时间转换为本地时发布的答案。该代码的好处是它考虑了 UTC 值时的 DST 状态，而不是计算时的当前DST 状态。在我之前为这个答案建议的 Chip Pearson 代码(在此链接(中并非如此。
要添加的代码模块
我们需要创建一个新的 VBA 代码模块，其中包含对 ashleedawg 代码的以下改编：
Option Explicit
'Adapted from ashleedawg's answer at
' https://stackoverflow.com/questions/23903872/convert-utc-time-to-local#50452663
'That answer, in turn, was adapted from code by Tim Hall at
' https://github.com/VBA-tools/VBA-UTC
'PUBLIC FUNCTIONS:
' - UTCtoLocal(utc_UtcDate As Date) As Date converts UTC datetimes to local
' - LocalToUTC(utc_LocalDate As Date) As Date converts local DateTime to UTC
'Accuracy confirmed for several variations of time zones & DST rules. (ashleedawg)
'===============================================================================
Private Type utc_SYSTEMTIME
utc_wYear As Integer: utc_wMonth As Integer: utc_wDayOfWeek As Integer: utc_wDay As Integer
utc_wHour As Integer: utc_wMinute As Integer: utc_wSecond As Integer: utc_wMilliseconds As Integer
End Type
Private Type utc_TIME_ZONE_INFORMATION
utc_Bias As Long: utc_StandardName(0 To 31) As Integer: utc_StandardDate As utc_SYSTEMTIME: utc_StandardBias As Long
utc_DaylightName(0 To 31) As Integer: utc_DaylightDate As utc_SYSTEMTIME: utc_DaylightBias As Long
End Type
'http://msdn.microsoft.com/library/windows/desktop/ms724421.aspx /ms724949.aspx /ms725485.aspx
#If VBA7 Then
Private Declare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long
Private Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long
Private Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long
#Else
Private Declare Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long
Private Declare Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long
Private Declare Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long
#End If
Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME ' "Helper Function" for Public subs (below)
With utc_DateToSystemTime
.utc_wYear = Year(utc_Value): .utc_wMonth = Month(utc_Value): .utc_wDay = Day(utc_Value)
.utc_wHour = Hour(utc_Value): .utc_wMinute = Minute(utc_Value): .utc_wSecond = Second(utc_Value): .utc_wMilliseconds = 0
End With
End Function
Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date ' "Helper Function" for Public Functions (below)
utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _
TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond)
End Function
'===============================================================================
Public Function UTCtoLocal(utc_UtcDate As Date) As Date
On Error GoTo errorUTC
Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION, utc_LocalDate As utc_SYSTEMTIME
utc_GetTimeZoneInformation utc_TimeZoneInfo
utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate
UTCtoLocal = utc_SystemTimeToDate(utc_LocalDate)
Exit Function
errorUTC:
Debug.Print "UTC parsing error: " & Err.Number & " - " & Err.Description: Stop
End Function
Public Function LocalToUTC(utc_LocalDate As Date) As Date
On Error GoTo errorUTC
Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION, utc_UtcDate As utc_SYSTEMTIME
utc_GetTimeZoneInformation utc_TimeZoneInfo
utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate
LocalToUTC = utc_SystemTimeToDate(utc_UtcDate)
Exit Function
errorUTC:
Debug.Print "UTC conversion error: " & Err.Number & " - " & Err.Description: Stop
End Function
之后，我们可以使用以下代码创建第二个模块，以从纪元秒转换为本地时间：
Option Explicit
Function EpochToLocal(ByVal unixSecs As Variant) As Variant
EpochToLocal = "" 'Default value returned in case the conversion is not possible
On Error Resume Next
If IsNumeric(unixSecs & "") Then EpochToLocal = UTCtoLocal(EpochToUTC(CLng(unixSecs)))
'UTCtoLocal is adapted from the answer posted by ashleedawg at
' https://stackoverflow.com/questions/23903872/convert-utc-time-to-local#50452663
End Function
Function EpochToUTC(ByVal unixSecs As Long)
EpochToUTC = DateAdd("s", unixSecs, #1/1/1970#)
End Function
然后，我们可以创建第三个VBA模块并粘贴以下宏以进行实际转换：
Option Explicit
Sub ConvertAllUnixTimestamps()
'This range must be set to the 1-column block of cells with all the epoch-seconds values;
' to simplify the code, this method assumes that this range has at least 2 rows
'The range is being hard-coded here, but it could be passed as a parameter in future
Dim epochColumn As Range: Set epochColumn = Range("C2:C6003")
'This range must be set to the first cell where the local times must be written
'The cell is being hard-coded here, but it could be passed as a parameter in future
Dim localFirstCell As Range: Set localFirstCell = Range("E2")
'Read in all the epoch values into a 2-dimensional array (assuming the range has 2+ rows)
Dim epochArr As Variant: epochArr = epochColumn.value
'Get the lower and upper bounds of the array's 1st dimension with the epoch values
Dim epochLb As Long: epochLb = LBound(epochArr, 1)
Dim epochUb As Long: epochUb = UBound(epochArr, 1)
'Get the lower bound of the array's 2nd dimension;
' since we only care about the 1st column of values, the 2nd dim's upper bound is not used
Dim index2 As Long: index2 = LBound(epochArr, 2)
'Get the number of epoch values to process
Dim epochCount As Long: epochCount = epochUb - epochLb + 1
'Convert all the values in the array from epoch seconds to local times
Dim i As Long
For i = epochLb To epochUb
epochArr(i, index2) = EpochToLocal(epochArr(i, index2))
Next
'Create a range that goes from the first cell and goes down [epochCount] rows,
' and then write the converted array to it
localFirstCell.Resize(epochCount).value = epochArr
End Sub
减去闰秒以获得更精确的 UTC 转换
我相信，在大多数情况下，上面的代码就可以了。然而，世界上的阿德里安僧侣可能不同意。这是因为纪元值中的秒数不一定与 UTC 对齐。正如维基百科所解释的那样，纪元时间戳可能没有考虑到偶尔插入UTC时间的讨厌的"闰秒"，以解释延迟地球自转的天文变化。如果需要考虑这些宝贵的秒数，上面提到的第二个模块，即具有EpochToLocal函数的模块，将需要替换为类似于以下代码的内容：
注意：如果要转换的纪元值来自计算自 1970 年 1 月 1 日以来实际秒数的时钟(例如基于 TAI 的时钟(，那么理论上需要在转换期间添加闰秒。但是，如果纪元值仅仅是 UTC 时间的"格式"，只是从 UTC 时间中减去 1970 年 1 月 1 日，则不应删除闰秒，因为它们已经被考虑在内。
Option Explicit
Dim LeapSecDates() As Variant 'Array to store all the dates when leap secs. were added to the UTC
Dim LeapSecLb As Long, LeapSecUb As Long 'Bounds of the leap-seconds array
Dim LeapSecDatesLoaded As Boolean 'Indicates whether the leap-seconds array has been loaded yet
Function EpochToLocal(ByVal unixSecs As Variant) As Variant
EpochToLocal = "" 'Default value returned in case the conversion is not possible
On Error Resume Next
If IsNumeric(unixSecs & "") Then EpochToLocal = UTCtoLocal(EpochToUTC(CLng(unixSecs)))
'UTCtoLocal is adapted from the answer posted by ashleedawg at
' https://stackoverflow.com/questions/23903872/convert-utc-time-to-local#50452663
End Function
Function EpochToUTC(ByVal unixSecs As Long)
Dim dte As Date
dte = DateAdd("s", unixSecs, #1/1/1970#) 'This takes us to UTC, but w/ extra leap secs.
dte = DateAdd("s", -LeapSecondsFor(dte), dte) 'Removing the extra leap seconds
EpochToUTC = dte
End Function
Private Function LeapSecondsFor(ByVal dte As Date)
Dim i As Long
If Not LeapSecDatesLoaded Then 'To save time, the leap-seconds array is only loaded once
'Based on table at https://en.wikipedia.org/wiki/Leap_second#Insertion_of_leap_seconds
' as of Dec 2019; the dates must be in ascending order
LeapSecDates = Array(#6/30/1972#, #12/31/1972#, #12/31/1973#, #12/31/1974# _
, #12/31/1975#, #12/31/1976#, #12/31/1977#, #12/31/1978#, #12/31/1979# _
, #6/30/1981#, #6/30/1982#, #6/30/1983#, #6/30/1985#, #12/31/1987#, #12/31/1989# _
, #12/31/1990#, #6/30/1992#, #6/30/1993#, #6/30/1994#, #12/31/1995# _
, #6/30/1997#, #12/31/1998#, #12/31/2005#, #12/31/2008#, #7/31/2012# _
, #6/30/2015#, #12/31/2016#) 'This array needs to be manually updated as new dates emerge
LeapSecLb = LBound(LeapSecDates)
LeapSecUb = UBound(LeapSecDates)
'Move the time to midnight of the next day for each date in the array
For i = LeapSecLb To LeapSecUb
LeapSecDates(i) = DateAdd("d", 1, LeapSecDates(i))
Next
LeapSecDatesLoaded = True
End If
'Get the number of leap-second dates that have elapsed up until the date [dte];
' e.g. if [dte] - 23 secs. is > the last 24 dates in the array, then 24 leap seconds
' must be removed
Dim leap As Long: leap = 0
Dim previousLeapSecs As Long
For i = LeapSecUb To LeapSecLb Step -1
previousLeapSecs = i - LeapSecLb
If DateAdd("s", -previousLeapSecs, dte) > LeapSecDates(i) Then
LeapSecondsFor = previousLeapSecs + 1
Exit Function
End If
Next
'If we are here, no leap seconds were added before [dte]
LeapSecondsFor = 0
End Function
请记住，上面的模块有许多额外的注释，使代码看起来比实际更长。如果您不需要所有的逐个播放，则可以删除许多注释以更好地了解代码尝试执行的操作。
你需要一个For循环：
Sub CalcDate()
Dim cell as Variant
For Each cell in Range("C2:C6003")
'2017
If cell.Value > 1483250400 And cell.Value < 1489298520 Then
Range(Cells(cell.Row, 3),Cells(cell.Row,5)).Value = ((Range(cell,"E10") - 21600) / 86400) + 25569
'Not sure if E10 depends on the C2 value, but use Cells(cell.row,column number) to get some
sort of logic to connect it back to the location of cell.
'blah blah blah
'2018
'blah blah blah
'2019
'blah blah blah
End If
Next cell
End Sub