处理数组中的数据时发生错误

Question

我想,以确定是否在两个日期之间的B柱秋季的日期(每月的第一天米年ñ和月份的最后一天,M-1年的N + 1)的几个周期.例如,9/20/2013(B列中的单元格值)介于:

7/1/2010 and 6/30/2011
7/1/2011 and 6/30/2012
7/1/2012 and 6/30/2013
7/1/2013 and 6/30/2014
7/1/2015 and 6/30/2016

如果为True,则列C的同一行中的单元格值将包含日期结束的结束时段的年份(在本例中为2014),如果为False,则返回空白单元格.以下是我需要检查的B列中的数据集:

9/11/2013
8/20/2015
8/22/2013
8/31/2001
(Blank cell)
8/31/2009
AAA
9/3/2013
(Blank cell)
9/25/2011
9/30/2013
10/10/2012
Anna
10/4/2015

首先,我使用以下代码进行了检查:

Sub CheckMyYear1_Click()
Dim i As Long, j As Long, Last_Row As Long, Period As Long
T0 = Timer

Last_Row = Cells(Rows.Count, "B").End(xlUp).Row
Period = 5


For j = 2 To Last_Row
    For i = 1 To Period
        Begin_Period = DateSerial(Year(Date) - i, Month(Date), 1)
        End_Period = DateSerial(Year(Date) - i + 1, Month(Date), 0)

        If Cells(j, "B") >= Begin_Period And Cells(j, "B") <= End_Period Then
            Cells(j, "C") = Year(End_Period)
            Exit For
        End If
    Next i

    If Cells(j, "C") = "" Then
        Cells(j, "C") = "Out of Period"
        Cells(j, "C").Font.Color = RGB(226, 107, 10)
    End If

    If Cells(j, "B") = "" Then
        Cells(j, "C") = "No Data"
        Cells(j, "C").Font.Color = vbRed
    ElseIf IsDate(Cells(j, "B").Value) = False Then
        Cells(j, "C") = "Not Date"
        Cells(j, "C").Font.Color = vbRed
    End If

Next j
Range("C2:C" & Last_Row).Copy

InputBox "The runtime of this program is ", "Runtime", Timer - T0
End Sub

它工作正常并返回正确的输出.为了提高性能,因为数据集的大小可能很大,我将数据集存储在一个数组中并循环遍历数组以检查其每个元素.这是我使用的代码:

Sub CheckMyYear2_Click()
Dim i As Long, j As Long, Last_Row As Long, Period As Long
T0 = Timer

Last_Row = Cells(Rows.Count, "B").End(xlUp).Row
Period = 5

ReDim MyDate(2 To Last_Row, 1 To 1)
ReDim MyYear(2 To Last_Row, 1 To 1)
MyDate = Range("B2:B" & Last_Row).Value

For j = 2 To Last_Row
    For i = 1 To Period
        Begin_Period = DateSerial(Year(Date) - i, Month(Date), 1)
        End_Period = DateSerial(Year(Date) - i + 1, Month(Date), 0)

        If MyDate(j, 1) >= Begin_Period And MyDate(j, 1) <= End_Period Then
            MyYear(j, 1) = Year(End_Period)
            Exit For
        End If
    Next i

    If MyYear(j, 1) = "" Then
        MyYear(j, 1) = "Out of Period"
        Cells(j, "C").Font.Color = RGB(226, 107, 10)
    End If

    If MyDate(j, 1) = "" Then
        MyYear(j, 1) = "No Data"
        Cells(j, "C").Font.Color = vbRed
    ElseIf IsDate(MyDate(j, 1).Value) = False Then
        MyYear(j, 1) = "Not Date"
        Cells(j, "C").Font.Color = vbRed
    End If

Next j
Range("C2:C" & Last_Row).Value = MyYear
Range("C2:C" & Last_Row).Copy

InputBox "The runtime of this program is ", "Runtime", Timer - T0
End Sub

使用上面的代码发生运行时错误"9".然后我点击F8以确定箭头指向的位置,但箭头没有指向任何线条.

这里有人知道如何修复错误吗？我也有兴趣了解上述任务的更好方法.

Answer 1

您的问题是,为动态数组分配范围会将每个维度的下限更改为1,即使您已使用ReDim将其设置为其他值.所以尽管如此:

ReDim MyDate(2 To Last_Row, 1 To 1)

一旦执行此操作,就会为您提供指定大小的数组:

MyDate = Range("B2:B" & Last_Row).Value

你的阵列实际上是 MyDate(1 to Last_Row - 1, 1 to 1)