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

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

1

Set clsSurchargeDetails = New cls_Connote