Vit*_*ata 8 excel vba date version excel-vba
似乎VBA已经在Excel 2016/2013中进行了更改,只要它开始在地方抛出错误,它就不会抛出Excel 2010.
以下代码执行以下操作:
在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月:
此功能/行为是否已记录？
好吧，这么说吧yes。虽然没有指定它会失败...但它确实说 1904 年日期系统的does not support日期早于1904 此处。
在 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 Date System -> 1461(VBA / 1900 Date System: 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 System。由于Worksheet切换到 1904 系统，因此不支持该日期。所以，是的，后面有某种转换可以参考31-12-1903；否则，对于 1904 System，它会尝试查找1/01/1908（1461对于 1904 System => 对于29231900 System = 1461+ 1462），并且错误不会显示（1904 系列 > 0）。
我猜想VBAas上的内容Date保留了其身份，无论该特定 中使用的日期系统Worksheet如何。但是，当您在 上进行操作时Worksheet，会受到限制。不确定这是否是一次发布削减，但我很确定他们已经等待机会摆脱这种意义上的进一步支持。
我认为你根本无法解决这个问题，除非你避免使用不同的系统混合源数据。尽管如此，如果您不应用天数，使用Long或Double（序列日期）的比较似乎不起作用offset。
下面的代码是您的修改，以了解其中的所有选项：
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（显然是一个错误？）混淆