如何在 Excel VBA 中循环创建新字典集合？

Question

我想将包含两列的范围转换为字典集合。例如，如果范围是

一种	乙
1	2
3	4
5	6

然后我想要（使用 JSON 符号）集合[{first:1, second:2}, {first:3, second:4}, {first:5, second:6}]。

我尝试了以下方法：

Function Make_Collection(r As Range) As Collection
    Dim out_collection As New Collection
    Dim row As Range
    For Each row In r.Rows
        Dim current_row As New Dictionary
        current_row.Item("first") = row.Cells(1, 1).Value2
        current_row.Item("second") = row.Cells(1, 2).Value2
        out_collection.Add current_row
    Next
    Set Make_Collection = out_collection
End Function

但我得到[{first:5, second:6}, {first:5, second:6}, {first:5, second:6}]，这是最后一行的三个副本，而不是每一行的字典。

我怎样才能解决这个问题？

编辑

下面@QHarr 给出了很好的答案。换句话说，我认为我的代码相当于

Function Make_Collection(r As Range) As Collection
    Dim out_collection As New Collection
    Dim row As Range
    For Each row In r.Rows
        Dim current_row As Dictionary
        current_row = New Dictionary
        current_row.Item("first") = row.Cells(1, 1).Value2
        current_row.Item("second") = row.Cells(1, 2).Value2
        out_collection.Add current_row
    Next
    Set Make_Collection = out_collection
End Function

但它实际上相当于

Function Make_Collection(r As Range) As Collection
    Dim out_collection As New Collection
    Dim row As Range
    For Each row In r.Rows
        Dim current_row As Dictionary 'Do nothing on second and later iterations
        If current_row is Nothing Then 'True on first iteration only
            Set current_row = New Dictionary 
        current_row.Item("first") = row.Cells(1, 1).Value2 'Change the object in place on
        current_row.Item("second") = row.Cells(1, 2).Value2 'second and later iterations
        out_collection.Add current_row 'Adds every time a reference to the same object
    Next
    Set Make_Collection = out_collection
End Function

Answer 1

欢迎来到避免由于意外/不需要的行为而自动实例化的世界。删除自动实例化并每次设置一个新的引用。

Option Explicit

Public Sub test()
    Dim c As Collection, rng As Range, i As Long

    Set rng = ActiveSheet.Range("A1:B3")
    
    Set c = Make_Collection(rng)
    
    For i = 1 To c.Count
        Debug.Print c.Item(i)("first"), " ", c.Item(i)("second")
    Next

End Sub

Function Make_Collection(r As Range) As Collection
    Dim out_collection As Collection, arr() As Variant
    Dim i As Long, current_row  As Scripting.Dictionary

    Set out_collection = New Collection
    arr = r.Value

    For i = LBound(arr, 1) To UBound(arr, 1)
        Set current_row = New Dictionary
        current_row.Item("first") = arr(i, 1)
        current_row.Item("second") = arr(i, 2)
        out_collection.Add current_row
    Next
    Set Make_Collection = out_collection
End Function

见这从美妙的芯片皮尔逊网站：

不要使用自动实例化对象变量

对于对象类型变量，可以在 Dim 语句中包含 New 关键字。这样做会创建所谓的自动实例化变量。同样，虽然这看起来很方便，但应该避免。与某些程序员可能认为的相反，在处理变量声明时不会创建对象。相反，对象是在代码中第一次遇到时创建的。这意味着，首先，您在创建对象时的控制有限。其次，这意味着您无法测试对象是否为 Nothing，这是代码中的常见测试以及常见的测试和诊断技术。如果编译器的输出是 VBA 代码，则处理自动实例化变量的代码如下所示：

Dim FSO As New Scripting.FileSystemObject
'''''''''''
' more code
'''''''''''
If FSO Is Nothing Then ' The compiler does something like this
    Set FSO = New Scripting.FileSystemObject
End If

在这里，简单地测试 FSO for Nothing 会导致创建对象，因此 FSO 永远不会正确测试 Nothing 状态。不要在变量的声明中使用 New，而是使用 Set New 语法：

Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject

与此：

Dim C As New Class1

这称为自动实例化变量。在代码中首次遇到变量 C 时，会创建一个新实例。通常，出于两个原因，您应该避免自动实例化变量：

首先，它增加了代码的开销，因为每次在代码中遇到变量时都必须测试它是否为 Nothing。

其次，您无法测试自动实例化变量是否为 Nothing，因为在 If Obj Is Nothing Then 语句中使用变量名称的行为将自动创建该变量的实例。

相关兴趣：

1. 声明时未实例化对象的原因是什么？
2. Excel VBA 自动实例化的性能不佳是一个神话吗？