VBA 数组下标越界问题

Question

Sub UpdateComplete()
Dim S As Worksheet
Dim C1 As Long
Dim R1 As Long
Dim R2 As Long
Dim N As Long
Set S = ThisWorkbook.ActiveSheet
C1 = S.Cells(1, Columns.Count).End(xlToLeft).Column
R1 = S.Cells(Rows.Count, 1).End(xlUp).Row
R2 = S.Cells(Rows.Count, C1).End(xlUp).Row

i = 0
j = 0
m = 0
Dim Newdate()
For k = 3 To R2
If DateValue(S.Cells(k, C1 - 3).Value) > DateValue(S.Cells(R1, 1).Value) _
And DateValue(S.Cells(k, C1 - 3).Value) <> DateValue(S.Cells(k - 1, C1 - 3).Value) Then

i = i + 1
ReDim Preserve Newdate(1 To i)
Newdate(i) = DateValue(S.Cells(k, C1 - 3).Value)
End If
Next k
Debug.Print Newdate(1)
N = UBound(Newdate) - LBound(Newdate) + 1
Dim DT()

For kk = 1 To N
For l = 1 To 225
j = j + 1
ReDim Preserve DT(1 To j)
DT(j) = Newdate(kk) + TimeValue(S.Cells(l + 1, 1))
Next l
Next kk

Dim PosArr()
For l = 1 To N * 225
m = m + 1
ReDim Preserve PosArr(1 To m, 1 To 2) （下标越界）

For ll = 2 To R2
If Abs(S.Cells(ll, C1 - 3).Value - DT(m)) < 0.000694 Then
PosArr(m, 1) = ll
PosArr(m, 2) = ll

ElseIf S.Cells(ll, C1 - 3).Value < DT(m) And S.Cells(ll + 1, C1 - 3).Value > DT(m) Then
PosArr(m, 1) = ll
PosArr(m, 2) = 0
End If

Next ll
Next l
End Sub

请问上面VBA代码哪里有问题，总出现下标越界和类型不一致问题？

Answer 1

首先您写的代码很不严谨。如：For k = 3 To R2您没有考虑到R2<3的情况，导致下标越界。

在第一个FOR循环中，如果没有出现符合条件的单元格，数组NEWDATE就没有赋值，这样又出现了下标越界的问题。第二个FOR循环中 DT(j) = Newdate(kk) + TimeValue(S.Cells(l + 1, 1))这句您定义的l变量赋值如果超过了符合条件的那个数组的最大值，肯
其次您没有约束您表格中的数据类型，一旦您写入的类型和代码类型不一致，马上出现类型不一致问题。然后你的变量值太大，没有约束，例如，第二个FOR循环中 DT(j) = Newdate(kk) + TimeValue(S.Cells(l + 1, 1))这句您定义的l变量赋值如果超过了符合条件的那个数组的最大值，肯顶会出现类型不一致。
最后，二维数组要先经过转置后才能进行循环操作。否则在定义后肯定会出现您括号中提示的下标越界问题。

PS:这个宏的目的我不是很明确，不过请把各种问题考虑到后再进行操作。

追问

为什么二维数组要先经过转置后才能进行循环操作

追答

因为用Preserve 保持数组的内容，只能改变数组最后一维的上界，如果改变了其它维或最后一维的下界，那么运行时就会出错。所以，想要使用二维数组只能通过转置。

Answer 2

你的动态数组定义错误。变化的只能是列，不可以是行，

ReDim Preserve PosArr(1 To 2, 1 To m)

这样定义就可以了，但是，你后面写入数据时，也要这样写入，输出结果时，用transpose函数转置回来即可。