以下是几个可能有用的函数,通过将 IsDST 的返回值与CheckDST 进行比较,然后相应地调整时区日期/时间值。例如:
Dim SomeDateTime As Date 'Or Double
If IsDST Then
'Is currently DST, so add an hour if the date/time to be checked includes a standard-time date.
If Not CheckDST(SomeDateTime) Then SomeDateTime = SomeDateTime + TimeSerial(1, 0, 0)
Else
'Is not currently DST, so subtract an hour if the date/time to be checked includes a DST date.
If CheckDST(SomeDateTime) Then SomeDateTime = SomeDateTime - TimeSerial(1, 0, 0)
End If
CheckDST:全功能版本。如果夏令时(或英国夏令时)适用于指定日期(在可选指定的语言环境中),则返回 True;否则返回 False。处理自 1966 年以来的所有美国 DST(和英国 BST)系统变化,包括 1973 年尼克松总统的“紧急夏令时节能法”和 1968 年 10 月 27 日至 1971 年 10 月 31 日哈罗德威尔逊的“英国标准时间”实验。
CheckDST_UK1972:简化版。如果 UK British Summer Time 适用于指定日期,则返回 True,基于自 1972 年以来定义的 BST 系统;否则返回 False。
CheckDST_US2007:简化版。如果美国联邦夏令时适用于指定日期,则返回 True,基于 2007 年建立的 DST 系统;否则返回 False。
IsDST:如果夏令时当前有效(在可选指定的语言环境中),则返回 True;否则返回 False。
NthDayOfWeekDate:返回指定月份中指定星期几的指定第 N 个实例的日期。
Option Explicit
Public Function CheckDST(ChkDate As Variant, Optional Locale As String = "USA") As Boolean
'
'Returns True if Daylight Savings Time applies to the specified date (in the optionally specified locale);
'otherwise returns False. Note that this function handles all dates back to 1/1/1966. For dates prior to
'that, an error message is displayed due to the difficulty of handling the highly inconsistent use of DST in
'prior years, across various locales.
'
'PARAMETERS:
'
' ChkDate The date to be checked for DST status. The data-type of the calling code's argument can
' be either Date or Double.
'
' Locale The geographic locale within which that locale's DST rules are to be applied. Values:
' "AZ" - DST hasn't applied to Arizona since 1967.
' "NN" - DST has applied in the Navajo Nation of northeastern Arizona.
' "AS" - DST has never applied in American Samoa (since WWII).
' "GU" - " Guam.
' "HI" - " Hawaii.
' "MP" - " Northern Marina Islands.
' "PR" - " Puerto Rico.
' "VI" - " Virgin Islands.
' "UK" - British Summer Time (BST) has been applied since the end of WWII (1945), from
' the last Sunday of March through the last Sunday of October, with one exception
' period from 1968 through 1971 in which it applied all year long (see details
' below).
' "USA" - All other states in the US, for which the federal DST rules have applied.
' Correctly handles President Nixon's "Emergency Daylight Saving Time Energy
' Conservation Act" of 1973.
'
'AUTHOR: Peter Straton
'
'*************************************************************************************************************
Const ThisFunction As String = "Function CheckDST()"
Const First As Integer = 1 'First instance in a month
Const Secnd As Integer = 2 'Second instance in a month
Const Last As Integer = 5 'Last instance: use max possible in a month
Const Mar As Integer = 3, Apr As Integer = 4, Oct As Integer = 10, Nov As Integer = 11
Const LawYearIdx As Integer = 0, StartInstanceIdx As Integer = 1, StartMonthIdx As Integer = 2, _
EndInstanceIdx As Integer = 3, EndMonthIdx As Integer = 4
Dim DateYear As Integer
Dim i As Integer
Dim StartInstance As Integer, StartMonth As Integer, EndInstance As Integer, EndMonth As Integer
Static US_StartEndSpecs As Variant
DateYear = Year(ChkDate)
If DateYear < 1966 Then
MsgBox "The specified date, " & ChkDate & ", is prior to this function's minimum date-year (1966) " & _
"which is necessary due to highly inconsistent use of DST in prior years, over various locales.", _
vbOKOnly + vbCritical, ThisFunction
Exit Function 'Return default: False
End If
Select Case Locale
Case "USA", "NN" 'Check these cases first, for execution efficiency and locale-logic shortcut
If ChkDate >= DateValue("1/6/1974") And ChkDate < DateValue("10/26/1975") Then
'Non-algorithmic case: On January 4, 1974, President Nixon signed the Emergency Daylight Saving Time
'Energy Conservation Act of 1973. Beginning on January 6, 1974, clocks were set ahead. On October 5,
'1974, Congress amended the Act, and Standard Time returned on October 27, 1974. Daylight Saving Time
'resumed on February 23, 1975 and ended on October 26, 1975.
'
'NOTE: Arizona was exempted.
If ChkDate >= DateValue("1/6/1974") And ChkDate < DateValue("10/27/1975") Or _
ChkDate >= DateValue("2/23/1975") And ChkDate < DateValue("10/26/1975") Then
CheckDST = True
Exit Function
End If
'Else
'Continue with DST calculation below...
End If
Case "UK" 'Check this case next, for execution efficiency and locale-logic shortcut
If ChkDate >= DateValue("10/27/1968") And ChkDate < DateValue("10/31/1971") Then
'Non-algorithmic case: The Harold Wilson government adopted "British Standard Time" (actually GMT+1,
'equivalent to DST) *throughout* the year. This took place between October 27, 1968 and October 31,
'1971 when there was a reversion back to the previous arrangement.
CheckDST = True
Exit Function 'Return default: False
'Else
'Continue with DST calculation below...
End If
StartInstance = Last: StartMonth = Mar 'Last Sunday of March
EndInstance = Last: EndMonth = Oct 'Last Sunday of October
Case "AZ"
If DateYear > 1967 Then Exit Function 'Hasn't participated in DST since 1967; return default: False
Case "AS", "GU", "HI", "MP", "PR", "VI"
Exit Function 'None of these have participated in DST (since WWII); return default: False
Case Else
MsgBox "Unknown Locale specification: """ & Locale & """", vbOKOnly + vbCritical, ThisFunction
End Select
If StartInstance = 0 Then '(If not defined above)
'If necessary, (re)initialize the DST start/end specs by DST law-date lookup table for the USA, then find
'the DST rule specs that apply, based on the specified date's year vs. the rule start-date years.
If IsEmpty(US_StartEndSpecs) Then '(Re)init if necessary...
US_StartEndSpecs = Array(Array(2007, Secnd, Mar, First, Nov), _
Array(1986, First, Mar, Last, Oct), _
Array(1966, Last, Apr, Last, Oct))
End If
For i = LBound(US_StartEndSpecs, 1) To UBound(US_StartEndSpecs, 1)
If DateYear >= US_StartEndSpecs(i)(LawYearIdx) Then Exit For
Next i
If i > UBound(US_StartEndSpecs, 1) Then
Stop 'DEBUG: SHOULD NEVER EXECUTE TO HERE DUE TO ChkDate PARAMETER VALUE CHECK, ABOVE.
Exit Function
End If
StartInstance = US_StartEndSpecs(i)(StartInstanceIdx) 'n-th Sunday of...
StartMonth = US_StartEndSpecs(i)(StartMonthIdx) 'some month
EndInstance = US_StartEndSpecs(i)(EndInstanceIdx) 'm-th Sunday of...
EndMonth = US_StartEndSpecs(i)(EndMonthIdx) 'some other month
End If
'Do the DST calculation based on the specifications defined above
CheckDST = ChkDate >= NthDayOfWeekDate(StartInstance, vbSunday, DateSerial(DateYear, StartMonth, 1)) And _
ChkDate < NthDayOfWeekDate(EndInstance, vbSunday, DateSerial(DateYear, EndMonth, 1))
End Function 'CheckDST
Public Function CheckDST_UK1972(ChkDate As Date) As Boolean
'
'Returns True if the UK "British Summer Time" applies to the specified date, based on the BST system as it's
'been defined since 1972; otherwise returns False. Note that this function does not take into account Harold
'Wilson's experimental "British Standard Time" which took place between October 27, 1968 and October 31, 1971.
'To correctly handle that date range, use the CheckDST function instead.
'
'PARAMETERS:
'
' ChkDate The date to be checked for DST status.
'
'AUTHOR: Peter Straton
'
'*************************************************************************************************************
Const Last As Integer = 5 'Last instance: use max possible in a month
Const Mar As Integer = 3, Oct As Integer = 10
Dim DateYear As Integer: DateYear = Year(ChkDate)
CheckDST_UK1972 = ChkDate >= NthDayOfWeekDate(Last, vbSunday, DateSerial(DateYear, Mar, 1)) And _
ChkDate < NthDayOfWeekDate(Last, vbSunday, DateSerial(DateYear, Oct, 1))
End Function 'CheckDST_UK1972
Public Function CheckDST_US2007(ChkDate As Date) As Boolean
'
'Returns True if the US Federal "Daylight Savings Time" applies to the specified date, based on the DST system
'established in 2007; otherwise returns False. Note that this function does not take into account locales
'such as Arizona, Hawaii or various US protectorates (Puerto Rico, Guam, etc.) so results for those locales
'will be unreliable. To correctly handle those locales, use the CheckDST function instead.
'
'PARAMETERS:
'
' ChkDate The date to be checked for DST status.
'
'AUTHOR: Peter Straton
'
'*************************************************************************************************************
Const First As Integer = 1 'First instance in a month
Const Secnd As Integer = 2 'Second instance in a month
Const Mar As Integer = 3, Nov As Integer = 11
Dim DateYear As Integer: DateYear = Year(ChkDate)
CheckDST_US2007 = ChkDate >= NthDayOfWeekDate(Secnd, vbSunday, DateSerial(DateYear, Mar, 1)) And _
ChkDate < NthDayOfWeekDate(First, vbSunday, DateSerial(DateYear, Nov, 1))
End Function 'CheckDST_US2007
Public Function IsDST(Optional Locale As String = "USA") As Boolean
'
'Returns True if Daylight Savings Time is *currently* in effect (in the optionally specified locale);
'otherwise returns False.
'
'*************************************************************************************************************
IsDST = CheckDST(Now(), Locale)
End Function
Function NthDayOfWeekDate(ByVal Instance As Integer, DayOfWeek As Integer, ByVal MonthDate As Date) As Date
'
'Returns the Date of the specified Nth instance of the specified day-of-week in the specified month.
'
'PARAMETERS:
'
' Instance The instance-number specified day-of-week in the month. To get the date of *last* instance in
' the month of the specified day-of-week, pass the value 5 as the argument to this parameter.
'
' DayOfWeek The day-number of the day-of-week for which the Nth instance is to be calculated. Can be any
' of: vbSunday, vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday, vbSaturday.
'
' MonthDate The date of the month in which the Nth day-of-week instance is to be calculated.
' (e.g. "3/2020" or "3/1/2020")
'
'AUTHOR: Peter Straton
'
'*************************************************************************************************************
Instance = IIf(Instance > 5, 5, Instance) 'Max: 5 possible instances
MonthDate = DateSerial(Year(MonthDate), Month(MonthDate), 1) 'Ensure that it's the first day of the month
NthDayOfWeekDate = MonthDate + Instance * 7 - Weekday(MonthDate + 7 - DayOfWeek)
If Month(NthDayOfWeekDate) <> Month(MonthDate) Then NthDayOfWeekDate = NthDayOfWeekDate - 7 '"Last" instance?
End Function