VBA 在 Excel 2016 中以不同方式处理日期？有这方面的文件吗？

Question

似乎 VBA 在 Excel 2016/2013 中发生了变化，就它开始在 Excel 2010 上不会抛出的地方抛出错误而言。

以下代码执行以下操作：

• 在 ActiveSheet 的第一行中创建 17 个日期；
• 用 4 个值填充日期数组
  • 第一行中的一个
  • 一个不在第一行
  • 1913年的一个
  • 1904 年之前的一个
• 它会查找每个值，如果找到，则将单元格涂成红色；

在 Excel 2010 中，它运行平稳，找到了一个值，而没有按预期找到其他 3 个值。一切正常。

在 Excel 2016/2013 中，它对 1904 之前的值不满意并抛出错误

无效的过程调用或参数（错误 5）

在Set foundRange = Rows(1).Find(someDates(cnt)) 上。

因此，似乎在 Excel 2016/2013 中的 Date1904 规则下，进行了某种检查，即 04.01.1900 在 1904 之前，因此无法解析为日期在 Excel 日期系统中？而在 Excel 2010 中并非如此。

所以问题 - 此功能/行为是否记录在案？

Public Sub TestMe()

    ThisWorkbook.Date1904 = True
    Cells.Clear                                          'clearing up all.
    Dim cnt     As Long

    For cnt = 3 To 20
        Cells(1, cnt) = DateAdd("M", cnt, DateSerial(2016, 1, 1))
        Cells(1, cnt).NumberFormat = "MMM-YY"
    Next cnt

    Dim someDates(3)    As Date
    someDates(0) = DateSerial(2016, 1, 1)               'exists
    someDates(1) = DateSerial(2012, 1, 1)               'does not exist in the range
    someDates(2) = 5000                                 '08.09.1913 (in VBA)
    someDates(3) = 5                                    '04.01.1900 (in VBA)

    Dim foundRange      As Range
    For cnt = LBound(someDates) To UBound(someDates)
        Set foundRange = Rows(1).Find(someDates(cnt))   'Error 5 in Excel 2016
        If Not foundRange Is Nothing Then
            foundRange.Interior.Color = vbRed
        End If
    Next cnt

    ThisWorkbook.Date1904 = False                        'all dates with 4 years back

End Sub

为什么在搜索 2016 年 1 月时选择 2016 年 11 月：

• Range.Find not making a difference between January and November (February and December) in VBA Excel

Answer 1

是否记录了此功能/行为？

好吧，让我们说yes。虽然没有指定它会失败...它确实说 1904 日期系统 does not support 日期早于 1904 here。

在 1904 年日期系统中，支持的第一天是 1904 年 1 月 1 日

我想以上对你来说没有什么新鲜事。

因此，似乎在 Excel 2016/2013 中的 Date1904 规则下，进行了某种检查，即 04.01.1900 早于 1904 年，因此无法将其解析为 Excel 日期中的日期系统？而在 Excel 2010 中并非如此

也许它不应该起作用？如果您尝试以下代码，它将无法在Worksheet 环境（Office 2016）上写入：

 Cells(1, 1) = CDate("01-01-1902")                    ' will fail to write the date only in Date1904
 Cells(1, 2) = CDate(-200)                            ' will fail to write the date (runtime error 1004)

因此，您在Worksheet 中未能找到无法写入的内容是有道理的。

以下代码为您提供在 1904 日期系统中失败的第一个序列日期 -> 1461（VBA / 1900 日期系统：31.12.1903）：

Public Sub TestMe2()
Dim strMsg As String
 On Error Resume Next
 ThisWorkbook.Date1904 = True
 For cnt = 5000 To 5 Step -1
    Set foundRange = Rows(1).Find(CDate(cnt))
    If Err.Number <> 0 Then
        'Error 5: cnt = 1461 (31.12.1903 in VBA)
        strMsg = "Range.Find failed for CDate(" & cnt & ")" & Chr(13) & _
            Err.Description
        MsgBox strMsg, vbInformation, "Gap found"
        GoTo Test2_End
    End If
    If Not foundRange Is Nothing Then foundRange.Interior.Color = vbGreen
 Next cnt
Test2_End:
 ThisWorkbook.Date1904 = False
End Sub

这意味着当调用Range.Find时，它确实将1461解释为31-12-1903，因此按照1900系统。由于Worksheet 已切换到 1904 系统，因此不支持该日期。所以，是的，后面有某种转化可以参考31-12-1903； 否则，对于 1904 系统，它会尝试找到 1/01/1908（1461 用于 1904 系统 => 这是 2923 用于 1900 系统 = 1461 + 1462），并且错误不会出现（1904 系列 > 0）。

我猜VBA 上的内容作为Date 保留了它的身份，而与特定Worksheet 中使用的日期系统 无关。但是，当您对Worksheet 进行操作时，会受到限制。不确定这是否是一个版本削减，但我很确定他们已经在等待机会在这个意义上摆脱进一步的支持。

我认为您根本无法解决它，除非您避免使用不同的系统混合源数据。尽管如此，如果您不应用 offset 天数，使用 Long 或 Double（序列日期）的比较似乎不起作用。

下面的代码是对你的修改，以了解那里的所有选项：

Public Sub TestMe()
Dim cnt As Long
Dim ws As Worksheet, rnCell As Range
Dim txt As String
Dim bln1904 As Boolean, offsetDays As Integer, blnOffset As Boolean

 On Error Resume Next

 ' Select testing mode
 bln1904 = (vbYes = MsgBox("Switch temporarily to Date1904?", vbYesNo, "Date Mode"))
 ThisWorkbook.Date1904 = bln1904

 If bln1904 Then
    blnOffset = (vbYes = MsgBox("Apply Offset Days for 1904 to date serials? (1642 days)", vbYesNo, "Date Conversion"))
 Else
    blnOffset = False
 End If

 ' Fill in Worksheet test data
 Cells.Clear                                          'clearing up all.

 Cells(1, 1) = CDate("01-01-1902")                    ' will fail to write the date only in Date1904
 Cells(1, 2) = CDate(-200)                            ' will fail to write the date
 Cells(1, 3) = CDate("31-03-2012")                    ' in Date1904 will write 30-03-2008
 Cells(1, 4) = CDate("31-10-2012")                    ' in Date1904 will write 30-10-2008
 For cnt = 5 To 20
    Set rnCell = Cells(1, cnt)
    rnCell = DateAdd("M", cnt - 2, DateSerial(2016, 1, 1))
 Next
 For cnt = 1 To 20
    Set rnCell = Cells(1, cnt)
    With rnCell
        .NumberFormat = "DD-MMM-YY"
        .ColumnWidth = 10
    End With
 Next cnt

 ' Fill in data to find
 Dim someDates(9)    As Date
 someDates(0) = DateSerial(2016, 1, 1) - IIf(bln1904 , offsetDays, 0)
 someDates(1) = 42370 - IIf(bln1904, offsetDays, 0)   '01.01.2016 (in VBA)
 someDates(2) = CDate("01-04-2016") - IIf(bln1904, offsetDays, 0)
 someDates(3) = 42461 - IIf(bln1904, offsetDays, 0)   '01.04.2016 (in VBA)
 someDates(4) = 42675 - IIf(bln1904, offsetDays, 0)   '01.11.2016 (in VBA)
 someDates(5) = 40999 - IIf(bln1904, offsetDays, 0)   '31.03.2012 (in VBA): 42461 - 1462
 someDates(6) = 41213 - IIf(bln1904, offsetDays, 0)   '31.10.2012 (in VBA): 42675 - 1462
 someDates(7) = 1462 - IIf(bln1904, offsetDays, 0)    '01.01.1904 (in VBA)
 someDates(8) = 1461 - IIf(bln1904, offsetDays, 0)    '31.12.1903 (in VBA)
 someDates(9) = 5 - IIf(bln1904, offsetDays, 0)       '04.01.1900 (in VBA)

 Dim foundRange      As Range
 Err.Clear
 For cnt = LBound(someDates) To UBound(someDates)
    Set foundRange = Rows(1).Find(someDates(cnt))
    If Err.Number <> 0 Then
        'Error 5: cnt = 8
        strMsg = "Range.Find failed for date " & Format(someDates(cnt), "DD-MM-YYYY") & _
            ". cnt = " & cnt & Chr(13) & Err.Description
        MsgBox strMsg, vbInformation, "Error found"
        GoTo Test_End:
    End If
    If Not foundRange Is Nothing Then
        With foundRange
            .Interior.Color = vbGreen
            If Not (.Comment Is Nothing) Then txt = .Comment.Text
            If Not (Trim(txt) = vbNullString) Then .Comment.Delete
            txt = IIf(Trim(txt) = vbNullString, "Found for date(s): ", txt & ", ") & _
                "D" & cnt & " " & Format(someDates(cnt), "DD-MM-YYYY")
            .AddComment (txt)
            txt = vbNullString
        End With
    End If
 Next cnt

Test_End:
 ThisWorkbook.Date1904 = False                        'all dates with 4 years back
End Sub

如果您尝试不同的选项，会发现如果没有偏移量，事情就会变得一团糟。顺便说一句，我不太确定它是如何将January 与November 混淆的（显然是一个错误？）