VBA 基于循环重新确定数组尺寸

Question

我正在尝试填充一个数组，但每次迭代都会增加 dim 1 的元素大小，但是当我尝试

时得到 "Subscript out of range message"

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

如前所述，您只能调整数组的最后一个维度（在您的示例中是第二个维度）

此外，请注意：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) 仍然不起作用，因为您将再次调整第一个维度的大小。

Re-dimension 你的数组是这样的：

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

尝试使用集合重写您的代码：

Dim sArray As New Collection

添加新元素

sArray.Add(item)

您永远不需要对集合使用 redim。它是自动处理的。 Google VBA 合集 了解更多信息。

VBA 基于循环重新确定数组尺寸

VBA re-dimensioning array based on a loop

arrays

vba

preserve