2013-05-08 73 views
1

這可能是一個新手錯誤,我不知道我沒有更改過某些設置。無論如何,我正在嘗試使用Dictionary來存儲我創建的類的實例。VBA:詞典 - 只能檢索最後一個條目

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只得到在字典中的最後一項。

任何幫助將是太棒了!

回答

0

要避免重複使用和添加的循環中相同的參考,當你需要一個新的實例(If (conTag = givenTag)後)只問一個:

Set clsSurchargeDetails = New cls_Connote 
+0

之所以如此,是真的!非常感謝 ! – OtakuPower 2013-05-09 00:56:42