Записи в словаре все имеют одинаковое значение, хотя они созданы индивидуально

Question

У меня есть таблица первенствовать для 1:n-Relationship

ID value 
---------- 
1 A 
1 B 
1 C 
2 A 
2 B 
3 F 
4 X 
4 Z 

и объект (CValueMap), который должен хранить значения для данного ID:

Option Explicit 

Public id As Integer 
Public values As Collection 

Я прочитал таблицу excel путем итерации строк, создавая CValueMap (если он еще не существует в моем словаре) и заполняя значения.

Dim idCell As Range 
Dim allValues As New Scripting.Dictionary 
allValues.RemoveAll 

For Each idCell In Range("id_value_table[ID]") 
    If Not allValues.Exists(idCell.value) Then 
     Dim newValueMap As New CValueMap 
     newValueMap.id = idCell.value 
     Set newValueMap.values = New Collection 
     allValues.Add idCell.value, newValueMap 
    End If 

    Dim valueMap As CValueMap 
    Set valueMap = allValues.Item(idCell.value) 
    valueMap.values.Add idCell.Offset(0, 1).value 
Next idCell 

Теперь я бы предположить, что у меня есть 4 CValueMap сек, где первый один имеет ABC, второй AB, третий F и последний XZ в качестве значений. Это, однако, не так, как показывает этот код:

'iterate allValues 
Dim singleKey as Variant 
For Each singleKey In allValues.Keys 
    Debug.Print singleKey & " has these values:" 
    Debug.Print "ID: " & allValues.Item(singleKey).id 
    Dim value As Variant 
    For Each value In allValues.Item(singleKey).values 
     Debug.Print " " & value 
    Next value 
Next singleKey 

.

---------------OUTPUT:------------------- 
1 has these values: 
ID: 4 
    X 
    Z 
2 has these values: 
ID: 4 
    X 
    Z 
3 has these values: 
ID: 4 
    X 
    Z 
4 has these values: 
ID: 4 
    X 
    Z 

Я не совсем уверен, где я ошибся. Из поведения я предположил, что такой же ValueMap мог бы быть записан в в каждой записи в словаре allValues, но так как я создал 4 отдельных и правильно загрузил их, прежде чем добавлять value s, я не вижу, где это могло произойти ,

Answer 1

Объект урок для вас - НИКОГДА использовать Dim... As New..., так как вы не можете контролировать, когда или когда вы получаете новый объект.

Простые изменения кода требуется:

Dim idCell    As Range 
Dim allValues    As Scripting.Dictionary 
Dim newValueMap   As CValueMap 

Set allValues = New Scripting.Dictionary 
allValues.RemoveAll 

For Each idCell In Range("id_value_table[ID]") 
    If Not allValues.Exists(idCell.value) Then 
     Set newValueMap = New CValueMap 
     newValueMap.id = idCell.value 
     Set newValueMap.values = New Collection 
     allValues.Add idCell.value, newValueMap 
    End If 

    Dim valueMap   As CValueMap 
    Set valueMap = allValues.Item(idCell.value) 
    valueMap.values.Add idCell.Offset(0, 1).value 
Next idCell 

Answer 2

Как раз перед вашим End If, добавьте следующую строку:

Set newValueMap = Nothing