尝试重设时为什么下标超出范围错误？

Question

我正在尝试制作一个动态数组，在循环中添加单位。 每次尝试重新设置单位并添加单位时，都会出现以下错误：

下标超出范围

我的代码：

dim arr()
strSql = "SELECT item from dupEmail"
    Set rs = CurrentDb.OpenRecordset(strSql)
    rs.MoveFirst
    ReDim arr(0)
    Do While Not rs.EOF
        arr(UBound(arr, 1)) = rs.Fields(0)
        ReDim Preserve arr(1, UBound(arr, 1) + 1)
        rs.MoveNext
    Loop

我尝试了ReDim Preserve arr(0, UBound(arr, 0) + 1)但是那也不起作用。

Answer 1

我认为更容易发布建议的代码：注释不能全部显示：您已经将Redim的索引设为0，所以您需要为每条记录递增。 它将在最后创建一个不必要的，将其删除。

dim arr()
strSql = "SELECT item from dupEmail"

Set rs = CurrentDb.OpenRecordset(strSql)
rs.MoveFirst
ReDim arr(0)
Do While Not rs.EOF
    arr(UBound(arr)) = rs.Fields(0)
    ReDim Preserve arr(UBound(arr) + 1)
    rs.MoveNext
Loop
ReDim Preserve arr(UBound(arr) - 1)

或者使用rs.RecordCount代替Redim（0）来简单地对所有记录进行redim，并避免在循环中使用Redim。 您当然需要一个柜台。

Answer 2

ReDim arr(a, b)

是相同的

ReDim arr(0 To a, 0 To b)

你想要的是

ReDim arr(a To b)

在您的情况下，您可以将Dim arr作为长度为1的一维数组，并带有ReDim arr(0) 。 然后，您尝试将它重新二维化为二维数组。 如果您不使用Preserve ，那么效果很好，但是使用Preserve它不知道将旧值放在哪里（我认为）并抛出错误。

因此，要解决您的问题，请将ReDim Preserve arr(1, UBound(arr, 1) + 1)替换为ReDim Preserve arr(1 To UBound(arr, 1) + 1)但注释中还提到了其他一些更可取的想法。 请记住，“重新命名”可能很耗时。 在最坏的情况下，程序必须在每次迭代中分配新的（更大）内存并从旧位置复制所有内容。 无论如何它可能不会引起注意，但是在循环之前分配整个数组仍然是更好的做法。

编辑：哦，没有注意到它已经在评论中提到。

edit2：在一个非代表性的测试中，循环内的重新执行大约是预先进行重新执行的时间的6倍。