关于类:VBA:字典 – 只能检索最后一个条目

VBA: Dictionary - Can only retrieve the last entry

这可能是一个新手错误,我不知道我没有更改某些设置。无论如何,我正在尝试使用 Dictionary 来存储我创建的类的实例。

cls_Connote 只是细节的容器。

1
2
3
4
5
6
7
8
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

这是我将详细信息存储到类中然后存储到字典中的方式。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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

这就是我试图从字典中取出内涵的方法。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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 只获取字典中的最后一个条目。

任何帮助都会很棒!


为避免在循环中重复使用和添加相同的引用,当您需要一个新实例时(在 If (conTag = givenTag) 之后)只需请求一个:

1
Set clsSurchargeDetails = New cls_Connote