使用字典检查多个列表的更优美的方式？

嵌套字典可能没问题，但我会考虑构建一个更易于维护的自定义对象

。

编辑

一个更具体的场景来说明数据流和对象使用情况
（不具有所有细节和要求，这就是我处理项目的方式）

。

预算工作表-从数据库/查询填充

。

费用表-从数据库/查询填充

。

Module1 -Main Sub- pseudo-code（不起作用，只是高层结构）

Option Explicit

Public Sub SetBudgets()
    Dim wsB As Worksheet, wsE As Worksheet, budgets As clsBudget, itm As Range

    Set wsB = ThisWorkbook.Worksheets("Budgets")
    Set wsE = ThisWorkbook.Worksheets("Expense")
    Set budgets = New clsBudget

    Dim ok As Boolean, funded As Boolean, budget As clsBudget

    ok = True
    For Each itm In wsB.UsedRange.Rows      'Initialize Budgets
        With itm
            If ok Then ok = budgets.Init(.Cells(1), .Cells(2), .Cells(3), .Cells(4))
        End With
    Next

    funded = True
    Set budget = New clsBudget
    If ok Then
        For Each itm In wsE.UsedRange.Rows  'Commit Expenses
            For Each budget In budgets
                funded = budget.Commit(itm.Cells(4), itm.Cells(5))
                If funded Then
                    itm.Cells(7) = "Funded by budget " & budget.BudgetFullName
                    Exit For
                End If
            Next
            If Not funded Then itm.Cells(7) = "Unfunded"
        Next
    End If
End Sub

为了优化性能，将所有数据（两个工作表）都移到数组中

。

类实现- clsBudget - pseudo-code（不工作，只是高层结构）

Option Explicit

Private Const ELIGIBILITY_LIST_DELIMITER = "||"

Private thisPriority    As Long     'Managed by the class
Private totalBudgets    As Long     'Managed by the class

Private priority        As Long     'Validated by the class
Private funds           As Double   '>= 0
Private fullName        As String   'Validated by the class (no special chars)
Private shortName       As String   'Validated by the class - extract initials
Private categories      As Dictionary   'No special chars, include other requirements...

Private Sub Class_Initialize()
    SetGlobals True
End Sub

Private Sub Class_Terminate()
    SetGlobals False
End Sub

Private Sub SetGlobals(Optional ByVal Init = False) 'reset all private variables
    thisPriority = 0
    totalBudgets = 0
    fullName = vbNullString
    '...
End Sub

Public Property Get BudgetFullName()  'define all accessor methods, and read-only props
    BudgetFullName = fullName
End Property

Public Function Init(ByVal budgetLonglName As Byte, ByVal budgetPriority As Long, _
       ByVal availableFunds As Double, ByVal eligibilityList As String) As Boolean

    If Len(budgetLonglName) = 0 Then Exit Function          'Return Error Details
    If budgetPriority <= currentPriority Then Exit Function 'Return Error Details
    If availableFunds <= 0 Then Exit Function               'Return Error Details
    If Len(eligibilityList) = 0 Then Exit Function          'Return Error Details

    fullName = budgetLonglName  'Remove special chars ("!@#$%^&*()_+{}|:<>?[]\;',./""")
    shortName = Split(fullName) 'For each itm extract first letter
    priority = budgetPriority
    funds = availableFunds

    Dim eList As Variant, cat As Variant
    eList = Split(eligibilityList, ELIGIBILITY_LIST_DELIMITER)

    For Each cat In eList
        'Remove special chars ("!@#$%^&*()_+{}|:<>?[]\;',./""")
        If Len(cat) > 0 Then categories(cat) = 0
    Next

    If categories.Count > 0 Then    'Budget is OK
        thisPriority = priority
        totalBudgets = totalBudgets + 1
        Init = True
    Else
        'Return Error Details
    End If
End Function

Private Function IsAvailable(ByVal category As String, _
                             ByVal expense As Currency) As Boolean

    If categories.Exists(category) Then IsAvailable = expense <= funds

End Function

Public Function Commit(ByVal category As String, _
                       ByVal expense As Currency) As Boolean
    If IsAvailable(category, expense) Then
        funds = funds - expense
        Commit = True
    End If
End Function

需要更多的逻辑来定义子类别（其他等）的资格映射，但是预算和费用之间的主要关系由类别字段驱动