VBA: Словарь - может только получить последнюю запись

Question

Это, вероятно, ошибка новичка, когда я не знаю о некоторых настройках, которые я не изменил. В любом случае, я пытаюсь использовать словарь для хранения экземпляров класса, который я создал.

Класс cls_Connote - это всего лишь контейнер деталей.

Public connoteNumber As String 
Public despatchDate As Date 
Public carrier As String 
Public service As String 
Public items As Integer 
Public weight As Integer 
Public cost As Single 
Public surchargeType As String 

Вот как я храню данные в классе, а затем в словаре.

Function getSurcharge_tag(givenTag As String, givenCol As String, ByRef dicStore As Dictionary, ByRef counter As Integer)` 

Dim tagLen As Integer 
Dim conNum, conTag As String 

Dim clsSurchargeDetails As New cls_Connote 
Dim despatchDate, carrier As String 
Dim items, weight As Integer 
Dim cost As Single 


Range(givenCol).Select 

tagLen = Len(givenTag) 

Do While (ActiveCell.Value <> "") 
    conNum = Mid(ActiveCell.Value, 1, Len(ActiveCell.Value) - 1) 
    conTag = Mid(ActiveCell.Value, Len(ActiveCell.Value) - tagLen + 1, Len(ActiveCell.Value)) 

    If (conTag = givenTag) Then 'Remove: both the Original and Adjusted connote lines 

     despatchDate = ActiveCell.Offset(0, -2).Value 
     items = ActiveCell.Offset(0, 10).Value 
     weight = ActiveCell.Offset(0, 11).Value 
     cost = ActiveCell.Offset(0, 12).Value 

     clsSurchargeDetails.connoteNumber = conNum 
     clsSurchargeDetails.despatchDate = despatchDate 
     clsSurchargeDetails.carrier = carrier 
     clsSurchargeDetails.items = items 
     clsSurchargeDetails.weight = weight 
     clsSurchargeDetails.cost = cost 
     clsSurchargeDetails.surchargeType = givenTag 

     dicStore.Add conNum, clsSurchargeDetails 
     givenCtr = givenCtr + 1 

     ActiveCell.EntireRow.Delete 
    Else 
     ActiveCell.Offset(1, 0).Select 
    End If 
Loop 
End Function 

Вот как я пытаюсь получить значки из Словаря.

Function displaySurcharges(wrkShtName As String, ByRef dicList As Dictionary) 

'Remove the existing worksheet 
Dim wrkSht As Worksheet 
On Error Resume Next 
    Set wrkSht = Sheets(wrkShtName) 
On Error GoTo 0 
If Not wrkSht Is Nothing Then 
    Worksheets(wrkShtName).Delete 
End If 

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = wrkShtName 

populateColumnHeaders 

Range("A2").Select 

Dim getCon As cls_Connote 
Set getCon = New cls_Connote 
Dim vPtr As Variant 
Dim ptrDic As Integer 

For Each vPtr In dicList.Keys 

    Set getCon = dicList.Item(vPtr) 

    ActiveCell.Value = getCon.connoteNumber 
    ActiveCell.Offset(0, 1).Value = getCon.despatchDate 
    ActiveCell.Offset(0, 2).Value = getCon.carrier 
    ActiveCell.Offset(0, 12).Value = getCon.items 
    ActiveCell.Offset(0, 13).Value = getCon.weight 
    ActiveCell.Offset(0, 15).Value = getCon.cost 
    ActiveCell.Offset(0, 16).Value = getCon.surchargeType 

    Set getCon = Nothing 
    ActiveCell.Offset(1, 0).Select 
Next vPtr 
End Function 

Я могу видеть dicList действительно содержит различные детали, getCon получает только последнюю запись в словаре.

Любая помощь будет фантастической!

Answer 1

Чтобы избежать повторного использования и добавления те же ссылок внутри цикла, когда вам нужен новый экземпляр (после If (conTag = givenTag)) просто попросить одного:

Set clsSurchargeDetails = New cls_Connote