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

Question

我想确定 B 列中的日期是否位于两个日期之间(m 年 n 月的第一天和 n 月的最后一天) >m-1 年n+1)在多个时期。例如，B 列中的单元格值 9/20/2013 是否属于:

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 年)，并且如果 将返回空白单元格>错误。下面是我需要检查的 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 知道箭头指向哪里，但箭头没有指向任何行。

Does anyone here know how to fix the error? I'm also interested in knowing the better way to do the task above.

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)