基于循环的VBA重新维度数组

Question

我正在尝试填充一个数组，但在每次迭代时增加了 dim 1 的元素大小，但是当我尝试时收到“下标超出范围消息”

ReDim Preserve sArray(1 To jTotal, 1 To UBound(sArray, 2))

有什么想法吗？

Dim j As Integer, jTotal As Integer
Dim eCount As Integer

ReDim sArray(1, 6)

For j = 1 To Application.Session.AddressLists.Item(AddList).AddressEntries.Count

    On Error GoTo Err

    If VBA.InStr(1, Application.Session.AddressLists.Item(AddList).AddressEntries.Item(j).GetExchangeUser.Department, _
    fFilter, vbTextCompare) > 0 Then

    jTotal = jTotal + 1

'    '--> Redimensioning the array
    ReDim Preserve sArray(1 To UBound(sArray, 1), 1 To UBound(sArray, 2))
    'ReDim Preserve sArray(1 To jTotal, 1 To UBound(sArray, 2))

    sArray(jTotal, 1) = j
    sArray(jTotal, 2) = Application.Session.AddressLists.Item(AddList).AddressEntries.Item(j).Name
    sArray(jTotal, 3) = Application.Session.AddressLists.Item(AddList).AddressEntries.Item(j).GetExchangeUser.Alias
    sArray(jTotal, 4) = Application.Session.AddressLists.Item(AddList).AddressEntries.Item(j).GetExchangeUser.PrimarySmtpAddress
    sArray(jTotal, 5) = Application.Session.AddressLists.Item(AddList).AddressEntries.Item(j).GetExchangeUser.BusinessTelephoneNumber
    sArray(jTotal, 6) = Application.Session.AddressLists.Item(AddList).AddressEntries.Item(j).GetExchangeUser.Department

    If Err.Number > 0 Then eCount = eCount + 1

    End If

Next j

Answer 1

正如in the comments 所提到的，您只能调整数组的最后一个维度（在您的示例中是第二个维度）

另外，请注意：ReDim sArray(1, 6)。它创建一个维度为 (0 to 1, 0 to 6) 而非 (1 to 1, 1 to 6) 的数组。所以Redim Preserve sArray(1 to 1, 1 to 6) 仍然不起作用，因为您将再次调整第一个维度的大小。

像这样重新调整数组的尺寸：

Sub Test()
    Dim sArray As Variant
    ReDim sArray(1 To 1, 1 To 6)
    ReDim Preserve sArray(1 To 1, 1 To 7)
End Sub

Answer 2

尝试使用 Collection 重写您的代码：

Dim sArray As New Collection

使用

添加新元素

sArray.Add(item)

您永远不需要将 redim 与 Collection 一起使用。它是自动处理的。 谷歌 VBA 集合 了解更多信息。