VBA创建以Collection为值的Dictionary遇取值为空问题求助

Great catch on that tricky As New behavior in VBA—this is one of the most common gotchas for new developers, so you’re already ahead by troubleshooting it! Let’s break down what happened, confirm your solution works, and share a more streamlined approach.

The Root Cause: Dim ... As New Reuses the Same Object #

Your initial issue comes down to how VBA handles Dim col As New Collection:

• This syntax uses late instantiation: VBA doesn’t create a new Collection until the first time you reference col.
• After that first instantiation, every subsequent use of col points to the same object instance. That’s why all your dictionary keys ended up sharing one giant collection, leading to empty or unexpected values when accessing specific items.

Your Solution is Valid #

Creating a helper function CreateCollection() to return a fresh Collection every time is a solid fix—it ensures each dictionary key gets its own, independent collection. This avoids the As New pitfall entirely.

A More Streamlined Implementation #

You can skip the helper function entirely by explicitly creating a new Collection with Set inside the Else block. This keeps your code more concise without losing clarity:

Option Explicit ' Always use this to catch undeclared variables!

Sub test()
    Dim dict As Scripting.Dictionary
    Set dict = CreateDict()
    Debug.Print "Done!"
    
    ' Optional: Verify the results
    Dim key As Variant
    Dim item As Variant
    For Each key In dict.Keys
        Debug.Print "Key: " & key
        For Each item In dict(key)
            Debug.Print vbTab & "Value: " & item
        Next item
    Next key
    
    ' Cleanup
    Set dict = Nothing
End Sub

Private Function CreateDict() As Scripting.Dictionary
    Dim dict As Scripting.Dictionary
    Set dict = New Scripting.Dictionary
    dict.CompareMode = vbTextCompare
    
    Dim xlApp As Excel.Application
    Dim wb As Excel.Workbook
    Dim wks As Excel.Worksheet
    ' Create a visible Excel instance (optional, easier for debugging)
    Set xlApp = CreateObject("excel.Application")
    xlApp.Visible = False ' Set to True if you need to see the workbook
    Set wb = xlApp.Workbooks.Open("S:\filename.xlsx")
    Set wks = wb.Worksheets(1)
    
    Dim Row As Long
    Dim key As Variant
    Dim value As Variant
    Dim col As Collection
    
    Row = 2
    Do While Not IsEmpty(wks.Cells(Row, 1))
        key = wks.Cells(Row, 1).Value ' Explicitly use .Value for clarity
        value = wks.Cells(Row, 3).Value
        
        If dict.Exists(key) Then
            dict(key).Add value
        Else
            ' Explicitly create a NEW Collection here
            Set col = New Collection
            col.Add value
            dict.Add key, col
        End If
        
        Row = Row + 1
    Loop
    
    ' Cleanup Excel objects to avoid background processes
    wb.Close savechanges:=False
    xlApp.Quit
    Set wks = Nothing
    Set wb = Nothing
    Set xlApp = Nothing
    
    Set CreateDict = dict
End Function

Key Improvements: #

1. Option Explicit: Forces you to declare all variables, preventing bugs from typos or undeclared variables (like your original Row, key, and value).
2. Explicit Object Cleanup: Properly closes the Excel instance and releases all object references—this stops hidden Excel processes from lingering in your task manager.
3. Avoid As New: Uses Set col = New Collection inside the loop to guarantee a fresh collection for each new key.
4. Explicit .Value: Makes it clear you’re reading cell values, not the cell objects themselves.

Bonus: Alternative Using Collection Directly in the Add #

You can even condense the Else block further by creating the collection inline:

Else
    dict.Add key, New Collection
    dict(key).Add value
End If

This works because New Collection creates a fresh instance right when you add it to the dictionary—no need for a separate col variable.

内容的提问来源于stack exchange，提问作者Nils