VBA类型不匹配通过函数将日期添加到字典中以查找2个日期之间的日期



我正试图将数组日期((数据类型中的键和日期添加到字典中,但我遇到了类型不匹配的错误,有什么想法吗?

Sub Test_Dates()
'
Dim TESTWB As Workbook
Dim TESTWS As Worksheet
Set TESTWB = ThisWorkbook
Set TESTWS = TESTWB.Worksheets("TEST")
Dim DatesDict As Scripting.Dictionary
For i = 1 To TESTWS.Cells(1, 1).End(xlDown).Row
DatesDict.Add TESTWS.Cells(i, 1), getDates(TESTWS.Cells(i, 2), TESTWS.Cells(i, 3))

Next i
End Sub

以下是获取两个日期(i,2(和(i,3(之间的日期的函数

Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant
Dim varDates()      As Date
Dim lngDateCounter  As Long
ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))
For lngDateCounter = LBound(varDates) To UBound(varDates)
varDates(lngDateCounter) = CDate(StartDate)
StartDate = CDate(CDbl(StartDate) + 1)
Next lngDateCounter
getDates = varDates
ClearMemory:
If IsArray(varDates) Then Erase varDates
lngDateCounter = Empty
End Function

似乎您的一行或多行在ColB或ColC中没有有效日期。

避免隐式Date转换将有助于调试:

例如:

Sub Test_Dates()
'
Dim TESTWB As Workbook
Dim TESTWS As Worksheet, i As Long, k
Dim DatesDict As Scripting.Dictionary
Dim dtStart As Date, dtEnd As Date

Set TESTWB = ThisWorkbook
Set TESTWS = TESTWB.Worksheets("TEST")
Set DatesDict = New Scripting.Dictionary

For i = 1 To TESTWS.Cells(Rows.Count, "A").End(xlUp).Row
With TESTWS.Rows(i)
dtStart = CDate(.Columns("B").Value) '<< explicit Date conversion
dtEnd = CDate(.Columns("C").Value)
If dtEnd >= dtStart Then
DatesDict.Add .Columns("A").Value, getDates(dtStart, dtEnd)
End If
End With
Next i

'checking...
For Each k In DatesDict
Debug.Print TypeName(k), k, DatesDict(k)(0)
Next k
End Sub
Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant
Dim varDates()      As Date
Dim lngDateCounter  As Long
ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))
For lngDateCounter = LBound(varDates) To UBound(varDates)
varDates(lngDateCounter) = CDate(StartDate)
StartDate = CDate(CDbl(StartDate) + 1)
Next lngDateCounter
getDates = varDates
End Function

相关内容

  • 没有找到相关文章

最新更新