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

У мене є таблиця Excel для 1:n-Relationship

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

І об'єкт (CValueMap), який повинен зберігати значення для даного ідентифікатора:

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Я не бачу, де це могло статися.

Відповіді:

Урок для вас для вас - НІКОЛИ використовувати 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

Як раз перед вашим кінцем, якщо додати цей рядок:

Set newValueMap = Nothing