Excel VBA - 集合字典（与其他一些方法和项目）

Question

试图实现一个容器容器，但似乎无法找到最佳方法。基本上，我有一系列可以包含多个子交易的交易，所以我正在尝试创建一个集合字典。每个事务将有一个唯一的密钥并持有一系列子事务。每个子交易都会有一个货币（密钥）、名义和佣金。

我创建了一个包含 SumNotional 和 SumCommission 项目的 Sub Transaction 类，因为我希望能够跟踪每个单独的 Sub Transaction 以及净金额。

Private Sub Class_Initialize()

    SumNotional = 0

    SumCommission = 0

    Set ItemList = New Collection

End Sub

一些伪代码理论上应该是这样的：

- Create Dictionary
- Get TransactionKey
- Create Sub Transaction with currency, notional and commission

- If Dictionary(TransactionKey) with currency doesn’t exist
    - create new Sub Transaction and add to Dictionary
- Else If Dictionary(TransactionKey) with currency exists
    - add line items to Sub Transaction for notional and commission
      - and add values to sum variables

不支持任何方式，这似乎是一种有效且高效的实施方式。示例是输入的数据如下所示：

Transaction  Currency  Notional  Commission
     A1        USD        500        50
     A2        USD      1,000       100
     A2        CAD        750        75
     A1        CAD        600        60
     A2        EUR        400        40
     A1        USD        300        30
     A1        CAD        175        20

结果将是一个看起来像的数据存储

A1
    USD    800    80
    CAD    775    80
A2
    USD  1,000   100
    CAD    750    75
    EUR    400    40

Answer 1

您可以使用字典词典

.

Option Explicit 'add Reference to "Microsoft Scripting Runtime" (VBA Editor -> Tools)

Public Sub NestedList()
    Const TR As Long = 1, CU As Long = 2, NO As Long = 3, CO As Long = 4
    Dim ws As Worksheet, itms As Dictionary, subs As Dictionary, prop As Dictionary
    Dim ur As Variant, lr As Long, r As Long, t As String, c As String

    Set ws = Worksheets("Sheet1")
    ur = ws.UsedRange
    lr = UBound(ur)
    Set itms = New Dictionary

    For r = 2 To lr
        t = ur(r, TR)   'Transaction
        c = ur(r, CU)   'Currency
        Set prop = New Dictionary
        Set subs = New Dictionary
        If Not itms.Exists(t) Then
            prop.Add Key:="N", Item:=ur(r, NO)  'Notional
            prop.Add Key:="C", Item:=ur(r, CO)  'Commission
            subs.Add Key:=c, Item:=prop         'Add Currency
            itms.Add Key:=t, Item:=subs         'Add Transaction
        Else
            If Not itms(t).Exists(c) Then
                prop.Add Key:="N", Item:=ur(r, NO)
                prop.Add Key:="C", Item:=ur(r, CO)
                itms(t).Add Key:=c, Item:=prop      'Add Currency
            Else
                itms(t)(c)("N") = itms(t)(c)("N") + ur(r, NO)   'Sum Notionals
                itms(t)(c)("C") = itms(t)(c)("C") + ur(r, CO)   'Sum Commissions
            End If
        End If
    Next
    ShowItms itms
End Sub

---

Private Sub ShowItms(ByRef itms As Dictionary)
    Dim t As Variant, c As Variant

    For Each t In itms
        Debug.Print t
        For Each c In itms(t)
            Debug.Print vbTab & c & " " & itms(t)(c)("N") & " " & itms(t)(c)("C")
        Next
    Next
End Sub

---

高层：

• 获取要使用的工作表 (Sheet1)
• 将其 UsedRange 放入变量数组 (ur)
• 获取最后一行：lr = Ubound(ur, 1) - 维度 1 的上限（代码中隐含）
• 初始化主字典（循环外）
• 循环遍历数组/工作表中的所有行
  • 如果主字典不包含当前事务（例如 A1）
    • 添加一个新的prop 字典，包含两个值N（名义）和C（佣金）
    • 将prop字典作为项目添加到字典subs
    • 将 subs 字典添加到主字典 (itms)
• Else（主字典包含当前事务 A1）
  • 如果subs 字典不包含当前货币
    • 添加一个新的prop 字典，包含两个值N（名义）和C（佣金）
    • 将 prop 字典添加到 subs(USD) 子字典，使用 Currency 作为键
    • 将subs 字典添加到itms(A1) 字典（主）
  • 其他
    • 总结迄今为止累积的 Notionals 值（针对此交易和货币）
    • 总结迄今为止累积的佣金值

最后，我们只需使用 sub ShowItms() 将结果打印到即时窗口

---

表 1

结果：

A1
    USD 800 80
    CAD 775 80
A2
    USD 1000 100
    CAD 750 75
    EUR 400 40