Question

我有一本字典，想向项目添加新的字符串。我的想法是为每个item创建一个字符串列表，作为key。

到目前为止，我的代码是

Sub AccountEntitlements()

    Dim sh1 As Worksheet
    Dim acc As Worksheet
    Dim arr() As Variant
    Dim d As Variant
    Dim i As Long
    Dim count As Long

    Set sh1 = Sheets("Sheet1")
    Set acc = Sheets("accountsentitlements")
    Set d = CreateObject("Scripting.Dictionary")

    arr = sh1.Range("D:F")

    For i = LBound(arr) To UBound(arr)
        If d.Exists(arr(i, 3)) Then
            ReDim Preserve arr(UBound(arr) + 1) '<- Error line
            d(arr(i, 3)) = Array(arr(i, 1))
        Else
            d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
        End If

    Next i

    For count = 1 To d.count - 1
        acc.Cells(count + 1, "D").Value = UCase(d.Keys()(count))
        acc.Cells(count + 1, "E").Value = d.Items()(count)
    Next count

End Sub

错误消息为Run-time error '9': Subscript out of range。

重要的代码块是

For i = LBound(arr) To UBound(arr)
     If d.Exists(arr(i, 3)) Then
          ReDim Preserve arr(UBound(arr) + 1) '<- Error line
          d(arr(i, 3)) = Array(arr(i, 1))
     Else
          d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
     End If

词典的键是用户帐户，项目应是其成员资格组。示例：

Key = ABCD，Item = Entitlement1，Entitlement2等

如何扩展项目数组并包括以前的条目？

Answer 1

其他问题：

您只能ReDim多维数组的最后一个元素。

您的行

arr = sh1.Range("D:F")

将创建一个基于1的2D数组：arr(1 to 1048576, 1 to 4)。如果您的数据库中有超过4*10^6个元素，则可能需要考虑使用其他工具。

因此有效的命令可能是

Redim Preserve arr(1 to ubound(arr,1), 1 to ubound(arr,2)+1)

但这不是您的工作。要完成您想做的事情，请尝试如下操作：

For i = LBound(arr) To UBound(arr)
    If d.Exists(arr(i, 3)) Then
        X = d(arr(i, 3))
        ReDim Preserve X(UBound(X, 1) + 1)
        X(UBound(X, 1)) = arr(i, 1)
        d(arr(i, 3)) = X
    Else
        d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
    End If    
Next i

但是为什么不只使用Dictionary或Collection来保存项目列表。然后，您完全不必担心调整数组大小。

Answer 2

非常感谢您的帮助（@Ron Rosenfeld）！

下面是我的最终代码部分。

For i = LBound(arr) To UBound(arr)
    If d.Exists(arr(i, 3)) Then
        d(arr(i, 3)) = d.Item(arr(i, 3)) & "," & arr(i, 1)
    Else
        d.Add Key:=arr(i, 3), Item:=arr(i, 1)
    End If
Next i

我仍在测试是否应该使用& "," &或JOIN()函数连接字符串，但最终决定了第一个选项。

关于我的数组大小，我添加了一个行计数器以适合数组的长度。 lrow = sh1.Cells(Rows.count, "D").End(xlUp).Row。

将项目添加到字典中的数组

2 个答案: