Dictionary 如何检查字典中的字段值，然后有条件地赋值？_Dictionary_Ms Access_Data Structures_Vba

Dictionary 如何检查字典中的字段值，然后有条件地赋值？

dictionary ms-access data-structures vba

Dictionary 如何检查字典中的字段值，然后有条件地赋值？,dictionary,ms-access,data-structures,vba,Dictionary,Ms Access,Data Structures,Vba,我正在努力实现以下目标：使用VBA在表格中循环，并使用以下三个参数为人员分配礼物： 1）个人的优先权得分 2）个人对接受何种礼物的偏好 3）库存中该类型礼品的数量理想情况下，VBA将从优先级1组的第一个记录开始，分配他们最喜欢的礼物（如果有库存），然后继续根据他们的偏好分配优先级1的个人，同时检查库存在表对象“tbl_gift_Assignments”（tbl_gift_Assignments））中为所有优先级1的个人分配了礼物（给定了“assigned_gift”（已分配的礼物）值

我正在努力实现以下目标：

使用VBA在表格中循环，并使用以下三个参数为人员分配礼物：

1）个人的优先权得分

2）个人对接受何种礼物的偏好

3）库存中该类型礼品的数量

理想情况下，VBA将从优先级1组的第一个记录开始，分配他们最喜欢的礼物（如果有库存），然后继续根据他们的偏好分配优先级1的个人，同时检查库存

在表对象“tbl_gift_Assignments”（tbl_gift_Assignments））中为所有优先级1的个人分配了礼物（给定了“assigned_gift”（已分配的礼物）值后，VBA将移到优先级2的个人，依此类推

现在，我在处理个人的首选礼品未列在库存表中的情况时遇到困难

在我的数据库中，我有下表（表对象称为“tbl\U礼物\U分配”）：

此外，我还有一个表，告诉我库存中每个项目的库存量（表对象称为“tbl_库存”）：

为了完成这项任务，我使用dictionary对象将每个礼物的库存缓存到内存字典中。每次我给唱片分配礼物时，它都会减少库存

到目前为止，我得到的VBA如下：

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim GiftInvDict As New Scripting.dictionary

Set db = CurrentDb()

Set rsInv = db.OpenRecordset("SELECT DISTINCT ItemID, Number_in_stock FROM tbl_Inventory")
While Not rsInv.EOF
    GiftsInvDict.Add Cstr(rsInv!ItemID), CInt(rsInv!Number_in_stock)
Loop
rsInv.Close

strSQL = "SELECT * FROM tbl_Gift_Assignments WHERE Priority =1"

Set rs = db.OpenRecordset(strSQL)

Do Until rs.EOF
    With rs
    'Process for each preferred item
    'Path #1_step_a: If preferred item is not in dictionary
        If Not GiftsInvDict.Exists(Cstr(rs!Preference_1)) Then
            ' Path #1_step_b: Add it to dictionary, with value of 0
            GiftsInvDict.Add Cstr(rsInv!Preference_1), 0 Then
            ' Path #1_step_c: Don't know how to tell it to jump
            ' to next preference
        End If
        ' Path #2_step_a: If preferred item is actually in dictionary
        ElseIf GiftInvDict.Exists(Cstr(rs!Preference_1)) Then
            ' Path #2_step_b: Check that the inventory is greater than 0
            If GiftsInvDict(Cstr(rs!Preference_1)) > 0 Then
                ' Path #2_step_c: If inventory greater than 0, change
                ''Gift_Assignment' value to preference
            .Edit
            !Gift_Assignment = rs!Preference_1
            .Update
            GiftsInvDict(!Preference_1) = GiftsInvDict(!Preference_1) - 1
            End If 
        'End of process for each preferred item 

        'Do the process again for 'Preference_2....Preference_N' until all preferences
        'are checked

        'If, after each preference has been through the process, preferred gifts cannot be assigned 
        'assign 'No_Gift_Available' value to 'Gift_Assignment' field
        Else
            .Edit
            !Gift_Assignment = "No_Gift_Available"
            .Update
        End If
        .MoveNext
    End With
Loop

rs.Close

Set rs = Nothing
Set db = Nothing

挑战

我知道个人列出了没有库存的偏好（没有列在“tbl_清单”中，如“按摩浴缸”、“雪橇”、“赛车”）。我目前的方法是让VBA检查dictionary对象中是否存在首选项，因为我不知道如何让VBA跳过dictionary对象中不存在的礼物首选项。如果没有，请将值为0的键添加到字典中。现在，VBA只是跳转到“Else”条件，在该条件下，您不会向个人分配礼物，即使他们有其他库存中的首选礼物（可能存在于dictionary对象中）

我终于在您的代码方面取得了一些进展。我不确定您是否在匆忙处理上述问题，或者剪切/粘贴问题，但我必须纠正至少5或6个编译错误

我只是简化了您的代码，以便它可以按顺序检查首选项。根据你想做什么，你需要解决好几件事。以下是我的建议：

修改您的查询以从tbl_礼物签名中选择所有并按优先级排序。这样，您可以在一个循环中处理所有问题

不确定您将有多少个“首选项”字段，但如果超过三个（或者它是否会改变），那么我建议在“Do While”中创建一个循环，该循环将在每列中旋转

我在最后添加了更新库存计数的代码，但不喜欢这种方法。我觉得这应该发生在礼物分配更新的同时。如果这个崩溃了，你会有一个皇家混乱

我没有添加任何代码来向表中添加新项。我不确定这是不是你想要的

最后，在处理字典以添加新项时，出现了一个bug。如果找不到“Racecar”，则会添加它，但下次有人查找“Racecar”时，它会再次添加

终于（真的，终于）。。。您可以删除我的所有“Debug.Print”语句

代码如下：

Option Compare Database
Option Explicit

Sub Assign_Gifts()

Dim db              As DAO.Database
Dim rs              As DAO.Recordset
Dim rsINV           As DAO.Recordset                        ' ** Not Defined
Dim strSQL          As String
Dim GiftsInvDict    As New Scripting.Dictionary             ' ** Needed 's' / inconsistent
Dim i               As Integer
Dim iQTY            As Integer
Dim itemArray

    Set GiftsInvDict = New Scripting.Dictionary
    Set db = CurrentDb()

    Set rsINV = db.OpenRecordset("SELECT DISTINCT ItemID, Number_in_stock FROM tbl_Inventory")
    Do While Not rsINV.EOF          ' Changed to DO
        GiftsInvDict.add CStr(rsINV!ItemID), CInt(rsINV!Number_in_stock)
        rsINV.MoveNext                      ' Missing MOVENEXT
    Loop                ' ** Loop without Do
    rsINV.Close


    Debug.Print "----- INVENTORY -----"
    Debug.Print "Count: " & GiftsInvDict.Count & vbTab & "C2: " & UBound(GiftsInvDict.Keys) + 1 & vbTab & "C3: " & UBound(GiftsInvDict.Items) + 1
    For i = 0 To GiftsInvDict.Count - 1
        Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
    Next i

    Debug.Print "----- NAMES -----"

    strSQL = "SELECT * FROM tbl_Gift_Assignments WHERE Priority =1"
    Set rs = db.OpenRecordset(strSQL)

    Do Until rs.EOF
        With rs
            Debug.Print rs!Name & vbTab & rs!Preference_1 & vbTab & rs!Preference_2 & vbTab & rs!Preference_n
            ' Check 1st Pref
            If Not GiftsInvDict.Exists(CStr(rs!Preference_1)) Then              ' Fails to find 'Racecar'!!!!
                Debug.Print "1st Pref not avail: " & rs!Preference_1 & vbTab & " add it "
                GiftsInvDict.Item(CStr(rs!Preference_1)) = 0
                Debug.Print "----- INVENTORY -----"
                Debug.Print "Count: " & GiftsInvDict.Count & vbTab & "C2: " & UBound(GiftsInvDict.Keys) + 1 & vbTab & "C3: " & UBound(GiftsInvDict.Items) + 1
                For i = 0 To GiftsInvDict.Count - 1
                    Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
                Next i
                Debug.Print "---------------------"
            Else
                iQTY = CInt(GiftsInvDict.Item(CStr(rs!Preference_1)))
                If iQTY > 0 Then
                    .Edit
                    !Gift_Assignment = rs!Preference_1
                    .Update
                    GiftsInvDict.Item(CStr(rs!Preference_1)) = CInt(iQTY - 1)
                    GoTo Satisfied
                End If
            End If

            ' Check 2nd Pref
            If Not GiftsInvDict.Exists(CStr(rs!Preference_2)) Then
                Debug.Print "2nd Pref not avail: " & rs!Preference_2 & vbTab & " add it "
                GiftsInvDict.Item(CStr(rs!Preference_2)) = 0
                Debug.Print "----- INVENTORY -----"
                Debug.Print "Count: " & GiftsInvDict.Count & vbTab & "C2: " & UBound(GiftsInvDict.Keys) + 1 & vbTab & "C3: " & UBound(GiftsInvDict.Items) + 1
                For i = 0 To GiftsInvDict.Count - 1
                    Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
                Next i
                Debug.Print "---------------------"

            Else
                iQTY = CInt(GiftsInvDict.Item(CStr(rs!Preference_2)))
                If iQTY > 0 Then
                    .Edit
                    !Gift_Assignment = rs!Preference_2
                    .Update
                    GiftsInvDict.Item((CStr(rs!Preference_2))) = CInt(iQTY - 1)
                    GoTo Satisfied
                End If
            End If

            ' Try 3rd choice --- being lazy, BUT I WOULD CHANGE ALL THIS CODE TO HANDLE ANY NUMBER OF PREDERENCES!!
            If Not IsNull(rs!Preference_n) Then
                If Not GiftsInvDict.Exists(CStr(rs!Preference_n)) Then
                    Debug.Print "nth Pref not avail: " & rs!Preference_n & vbTab & " add it "
                    GiftsInvDict.Item(CStr(rs!Preference_n)) = 0
                    Debug.Print "----- INVENTORY -----"
                    Debug.Print "Count: " & GiftsInvDict.Count & vbTab & "C2: " & UBound(GiftsInvDict.Keys) + 1 & vbTab & "C3: " & UBound(GiftsInvDict.Items) + 1
                    For i = 0 To GiftsInvDict.Count - 1
                        Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
                    Next i
                    Debug.Print "---------------------"

                Else
                    iQTY = CInt(GiftsInvDict.Item(CStr(rs!Preference_n)))
                    If iQTY > 0 Then
                        .Edit
                        !Gift_Assignment = rs!Preference_n
                        .Update
                        GiftsInvDict.Item(!Preference_n) = CInt(iQTY - 1)
                        GoTo Satisfied
                    End If
                End If
            Else
                Debug.Print "Pref_n is NULL"
            End If

            .Edit
            !Gift_Assignment = "No_Gift_Available"
            .Update

            'End of process for each preferred item

            'Do the process again for 'Preference_2....Preference_N' until all preferences
            'are checked

            'If, after each preference has been through the process, preferred gifts cannot be assigned
            'assign 'No_Gift_Available' value to 'Gift_Assignment' field
Satisfied:
            .MoveNext
        End With
    Loop

    rs.Close

    Debug.Print "-----------------------------------------------------------------------"

    'Add code to insert new records into Inventory if desired....
    For i = 0 To GiftsInvDict.Count - 1
        Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
        strSQL = "UPDATE tbl_Inventory SET tbl_Inventory.Number_in_stock = " & CInt(GiftsInvDict.Items()(i)) & " " & _
                 "WHERE (((tbl_Inventory.ItemID)='" & CStr(GiftsInvDict.Keys()(i)) & "'));"
        db.Execute strSQL, , iRecAff
    Next i

    Set rs = Nothing
    Set db = Nothing

End Sub

一般来说，如果您有编号的字段/列（pref_1，pref_2），您需要重新考虑您的数据库设计。如果“pref_1不可用，但pref_2可用，您应该分配它吗？@WayneG.Dunn：是的，这是正确的。@Wayne_G_Dunn：对您的方法的逐步解释非常好。我还认为最好不要更新库存盘点。另外，正如您正确猜测的，我不想向表中添加项。

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim GiftInvDict As New Scripting.dictionary

Set db = CurrentDb()

Set rsInv = db.OpenRecordset("SELECT DISTINCT ItemID, Number_in_stock FROM tbl_Inventory")
While Not rsInv.EOF
    GiftsInvDict.Add Cstr(rsInv!ItemID), CInt(rsInv!Number_in_stock)
Loop
rsInv.Close

strSQL = "SELECT * FROM tbl_Gift_Assignments WHERE Priority =1"

Set rs = db.OpenRecordset(strSQL)

Do Until rs.EOF
    With rs
    'Process for each preferred item
    'Path #1_step_a: If preferred item is not in dictionary
        If Not GiftsInvDict.Exists(Cstr(rs!Preference_1)) Then
            ' Path #1_step_b: Add it to dictionary, with value of 0
            GiftsInvDict.Add Cstr(rsInv!Preference_1), 0 Then
            ' Path #1_step_c: Don't know how to tell it to jump
            ' to next preference
        End If
        ' Path #2_step_a: If preferred item is actually in dictionary
        ElseIf GiftInvDict.Exists(Cstr(rs!Preference_1)) Then
            ' Path #2_step_b: Check that the inventory is greater than 0
            If GiftsInvDict(Cstr(rs!Preference_1)) > 0 Then
                ' Path #2_step_c: If inventory greater than 0, change
                ''Gift_Assignment' value to preference
            .Edit
            !Gift_Assignment = rs!Preference_1
            .Update
            GiftsInvDict(!Preference_1) = GiftsInvDict(!Preference_1) - 1
            End If 
        'End of process for each preferred item 

        'Do the process again for 'Preference_2....Preference_N' until all preferences
        'are checked

        'If, after each preference has been through the process, preferred gifts cannot be assigned 
        'assign 'No_Gift_Available' value to 'Gift_Assignment' field
        Else
            .Edit
            !Gift_Assignment = "No_Gift_Available"
            .Update
        End If
        .MoveNext
    End With
Loop

rs.Close

Set rs = Nothing
Set db = Nothing

Option Compare Database
Option Explicit

Sub Assign_Gifts()

Dim db              As DAO.Database
Dim rs              As DAO.Recordset
Dim rsINV           As DAO.Recordset                        ' ** Not Defined
Dim strSQL          As String
Dim GiftsInvDict    As New Scripting.Dictionary             ' ** Needed 's' / inconsistent
Dim i               As Integer
Dim iQTY            As Integer
Dim itemArray

    Set GiftsInvDict = New Scripting.Dictionary
    Set db = CurrentDb()

    Set rsINV = db.OpenRecordset("SELECT DISTINCT ItemID, Number_in_stock FROM tbl_Inventory")
    Do While Not rsINV.EOF          ' Changed to DO
        GiftsInvDict.add CStr(rsINV!ItemID), CInt(rsINV!Number_in_stock)
        rsINV.MoveNext                      ' Missing MOVENEXT
    Loop                ' ** Loop without Do
    rsINV.Close


    Debug.Print "----- INVENTORY -----"
    Debug.Print "Count: " & GiftsInvDict.Count & vbTab & "C2: " & UBound(GiftsInvDict.Keys) + 1 & vbTab & "C3: " & UBound(GiftsInvDict.Items) + 1
    For i = 0 To GiftsInvDict.Count - 1
        Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
    Next i

    Debug.Print "----- NAMES -----"

    strSQL = "SELECT * FROM tbl_Gift_Assignments WHERE Priority =1"
    Set rs = db.OpenRecordset(strSQL)

    Do Until rs.EOF
        With rs
            Debug.Print rs!Name & vbTab & rs!Preference_1 & vbTab & rs!Preference_2 & vbTab & rs!Preference_n
            ' Check 1st Pref
            If Not GiftsInvDict.Exists(CStr(rs!Preference_1)) Then              ' Fails to find 'Racecar'!!!!
                Debug.Print "1st Pref not avail: " & rs!Preference_1 & vbTab & " add it "
                GiftsInvDict.Item(CStr(rs!Preference_1)) = 0
                Debug.Print "----- INVENTORY -----"
                Debug.Print "Count: " & GiftsInvDict.Count & vbTab & "C2: " & UBound(GiftsInvDict.Keys) + 1 & vbTab & "C3: " & UBound(GiftsInvDict.Items) + 1
                For i = 0 To GiftsInvDict.Count - 1
                    Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
                Next i
                Debug.Print "---------------------"
            Else
                iQTY = CInt(GiftsInvDict.Item(CStr(rs!Preference_1)))
                If iQTY > 0 Then
                    .Edit
                    !Gift_Assignment = rs!Preference_1
                    .Update
                    GiftsInvDict.Item(CStr(rs!Preference_1)) = CInt(iQTY - 1)
                    GoTo Satisfied
                End If
            End If

            ' Check 2nd Pref
            If Not GiftsInvDict.Exists(CStr(rs!Preference_2)) Then
                Debug.Print "2nd Pref not avail: " & rs!Preference_2 & vbTab & " add it "
                GiftsInvDict.Item(CStr(rs!Preference_2)) = 0
                Debug.Print "----- INVENTORY -----"
                Debug.Print "Count: " & GiftsInvDict.Count & vbTab & "C2: " & UBound(GiftsInvDict.Keys) + 1 & vbTab & "C3: " & UBound(GiftsInvDict.Items) + 1
                For i = 0 To GiftsInvDict.Count - 1
                    Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
                Next i
                Debug.Print "---------------------"

            Else
                iQTY = CInt(GiftsInvDict.Item(CStr(rs!Preference_2)))
                If iQTY > 0 Then
                    .Edit
                    !Gift_Assignment = rs!Preference_2
                    .Update
                    GiftsInvDict.Item((CStr(rs!Preference_2))) = CInt(iQTY - 1)
                    GoTo Satisfied
                End If
            End If

            ' Try 3rd choice --- being lazy, BUT I WOULD CHANGE ALL THIS CODE TO HANDLE ANY NUMBER OF PREDERENCES!!
            If Not IsNull(rs!Preference_n) Then
                If Not GiftsInvDict.Exists(CStr(rs!Preference_n)) Then
                    Debug.Print "nth Pref not avail: " & rs!Preference_n & vbTab & " add it "
                    GiftsInvDict.Item(CStr(rs!Preference_n)) = 0
                    Debug.Print "----- INVENTORY -----"
                    Debug.Print "Count: " & GiftsInvDict.Count & vbTab & "C2: " & UBound(GiftsInvDict.Keys) + 1 & vbTab & "C3: " & UBound(GiftsInvDict.Items) + 1
                    For i = 0 To GiftsInvDict.Count - 1
                        Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
                    Next i
                    Debug.Print "---------------------"

                Else
                    iQTY = CInt(GiftsInvDict.Item(CStr(rs!Preference_n)))
                    If iQTY > 0 Then
                        .Edit
                        !Gift_Assignment = rs!Preference_n
                        .Update
                        GiftsInvDict.Item(!Preference_n) = CInt(iQTY - 1)
                        GoTo Satisfied
                    End If
                End If
            Else
                Debug.Print "Pref_n is NULL"
            End If

            .Edit
            !Gift_Assignment = "No_Gift_Available"
            .Update

            'End of process for each preferred item

            'Do the process again for 'Preference_2....Preference_N' until all preferences
            'are checked

            'If, after each preference has been through the process, preferred gifts cannot be assigned
            'assign 'No_Gift_Available' value to 'Gift_Assignment' field
Satisfied:
            .MoveNext
        End With
    Loop

    rs.Close

    Debug.Print "-----------------------------------------------------------------------"

    'Add code to insert new records into Inventory if desired....
    For i = 0 To GiftsInvDict.Count - 1
        Debug.Print GiftsInvDict.Keys()(i), GiftsInvDict.Items()(i)
        strSQL = "UPDATE tbl_Inventory SET tbl_Inventory.Number_in_stock = " & CInt(GiftsInvDict.Items()(i)) & " " & _
                 "WHERE (((tbl_Inventory.ItemID)='" & CStr(GiftsInvDict.Keys()(i)) & "'));"
        db.Execute strSQL, , iRecAff
    Next i

    Set rs = Nothing
    Set db = Nothing

End Sub