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

【问题标题】：Add items to Array in Dictionary将项目添加到字典中的数组
【发布时间】：2019-03-25 10:20:32
【问题描述】：

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

到目前为止我的代码：

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 等

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

【问题讨论】：

使用字典或集合而不是数组来保存成员组。为什么要创建这么大的数组来循环呢？
这个错误是因为你只能Redim Preserve一个多维数组的最后一个元素。由于您已经 arr= Range("D:F"), and your Redim Preserve arr(...` 语句必须失败。它没有作用于字典中的数组。
@RonRosenfeld，“这么大的阵列”是什么意思？你将如何拆分数组？
arr = Range("D:F") 创建一个维度数组(1 to 1048576, 1 to 4)。你的数据库里有这么多项目吗？要进行良好的讨论，请参阅 Chip Pearsons 在Arrays and Ranges in VBA 上发表的文章
@RonRosenfeld，我有 81.000 行。谢谢你的链接。我去看看。

标签： arrays excel vba dictionary

【解决方案1】：

其他问题：

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

你的线路

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

将创建一个基于 1 的二维数组：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 来保存您的项目列表。那么您就不必担心调整数组的大小了。

【讨论】：

【解决方案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.

【讨论】：