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

Posted 2023-02-25

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

【英文标题】：VBA treating dates differently in Excel 2016? Is there any documentation about this?

【发布时间】：2018-08-02 04:14:50

【问题描述】：

似乎 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

【问题讨论】：

此处观察相同（在 Excel 2007 中工作正常，在 Excel 2016 中引发错误）。顺便说一句，为什么 Find 返回someDates(0) 的单元格？

回答您的问题：不，我认为这没有明确记录。顺便说一句，这个问题也出现在 Excel 2013 中。就我个人而言，我总是避免使用 VBA 日期数据类型的日期雷区，Range.Value 的相关隐式转换以及相当有问题的 .Find 并坚持将日期视为双精度并使用 .value2跨度>

@Vityata 我可能遗漏了一些东西，你能开发吗？在我的电脑上，代码为 J1 单元格着色，日期为 2016 年 11 月。即使有 4 年的偏移量，也不应该“找到”这个单元格。 Find 是否使用字符串来比较日期并搞砸 11/1/2016 和 1/1/2016？我原以为它会比较数值。

运行时错误 5“无效的过程参数”也很明显，因为 ThisWorkbook.Date1904 = True 5 = 1900-01-04 不是日期。第一个日期是 0 = 1904-01-01。

对不起，我想我误解了。我的坏 - 文字可能很糟糕。 （我哥哥和我曾经因为连字符缺失而有 6 个月没有说话。“我重新发送了那封电子邮件”变成了“我重新发送了那封电子邮件。”...

【参考方案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 混淆的（显然是一个错误？）

【讨论】：

或许你可以看看最后的代码，把bln104改成bln1904？但总的来说，似乎真的有“无声更新”。我发现了这个“功能”，因为它在切换到 Office 2016 后意外弹出。因此，我要求文档的想法可能是在文档的地方我也可以找到其他“无声”更新。关于January 和November，请选择look here。

@Vityata：感谢您的纠正和上面的链接。幸运的是，我不必进行此类搜索，因此我不必依赖原生 Find。但是，如果必须，converting 到字符串ISO8601，并搜索转换后的字符串是我尝试实现它的方式。可能有一些方法可以使用相同的范围（无需将源范围复制到新的电子表格）。