使用字典检查多个列表的更优雅方式是什么？

时间：2018-06-15 21:00:57

标签： vba access-vba

这还处于早期阶段，所以我没有代码可以分享 - 但我想确保我从一开始就使用正确的工具。我的项目是预算优化脚本。现在，我计划使用词典来存储预算名称并循环遍历每个预算名称，然后将费用ID与符合这些预算的费用列表进行比较。我不确定我是否打算使用合适的工具。

举一个如何工作的例子，如果我有医疗费用，我想从我的健康储蓄账户HSA支付。但是，如果我的HSA不够，我将使用我的普通基金来支付。 HSA将被定义为比一般情况更优先的资金。

另一项费用，如一瓶波本威士忌，仍将根据HSA进行检查，因为它会将每个预算从最高优先级循环到最低优先级，但ID不在HSA的合格列表中，因此它只能使用普通基金（或其他专业基金）支付。

使预算变得复杂，预算的数量和名称不限于特定数量。我希望能够根据需求变化定义2或200个预算。符合条件的内容将在针对费用列表为每个预算设置的查询中定义。 （所以，像

select expenseid from tblexpenses where category in ("MEDICAL","DENTAL")

将用于HSA，但另一个可能与另一个预算重叠，因为有一个旧的保险金罐。资格查询可能是：

select expenseid from tblexpenses where category = "DENTAL" and expensedate < to_date("2018-01-01","yyyy-mm-dd");

有一个表格，其中存储了所有预算及其资格查询名称。我将使用它来填充预算列表并在循环中用于测试费用。

我目前的整体计划是：

  1. 创建预算清单（字典）
  2. 从生成符合条件的费用列表的多个查询中创建资格列表（字典？）。
  3. 评估费用，将其排名从最重要到最不重要
  4. 对于每个预算，比较每个费用ID（字符串）与资格
  5. 如果费用ID在预算的资格列表中且预算大于费用，则标记为该预算的资金，减少该金额使用的预算，然后继续。
  6. 如果没有，则测试下一个预算（转到5），直到不再有预算。如果没有匹配，则标记为无资金。
  7. 为每个费用执行此操作，直到文件结束。
  8. 最后，报告剩余预算以及每项费用的方式 支付。

    9. 我的问题是如何最优雅地存储构建多个列表。我一直在考虑直接查询表，使用记录集，数组或字典，到目前为止看起来字典是赢家，但我不知道如何复制我需要的查询测试，在SQL中类似于SELECT count（1）来自tblEligibility WHERE budget = [BudgetID]和expenseID = [ExpenseID]。字典似乎能够对费用ID进行最后检查，但不能同时检查两者。

    连连呢？我是在正确的轨道上吗？

    编辑 - tl：dr;版本：

    我需要使用三个列表。一个是静态的，一个驱动循环的简单列表。第二个是具有两个数据元素的资格列表 - 预算ID和费用ID - 我需要能够检查该列表中是否存在组合对。最后一个是我需要能够随时修改的值。所有列表都由Access数据库中存在的表或查询填充。

1 个答案:

答案 0 :(得分：2)

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

ObjectsVsNestedDictionaries

修改

用于说明数据流和对象使用的更具体方案
（没有所有细节和要求，这就是我接近项目的方式）

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

填充

Budgets

费用表格 - 从数据库/查询

填充

Expenses

模块1 - 主要子 - 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

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

相关问题
最新问题