MS-Access中基于双参数记录集分组Options的VBA实现问询

需求背景 #

我有两个表Parameters 1和Parameters 2，二者均与第三个表Options存在多对多关系。需要将Options表记录分为三组：

• 仅与指定Parameter 1记录关联的记录
• 仅与指定Parameter 2记录关联的记录
• 同时与指定Parameter 1和Parameter 2记录关联的记录

需忽略与二者均无关的Options记录，通过表单中的组合框（combo boxes）指定Parameter 1和Parameter 2的具体记录，由VBA在后台维护上述三个列表，并在表单中通过复选框（check boxes）使用Options记录时实时更新列表。

未完成的VBA代码框架 #

Function SetOptions()
    If IsNull(cmbParam1) Or IsNull(cmbParam2) Then
        MsgBox "You must select both an Param1 and a Param2!", vbCritical, "Wait!"
        Exit Function
    End If
    
    'Recordsets of allowed Options
    Dim Param1Opt, Param2Opt, OverlapOpt
    
    'create recordset of tblOption.Option(s) referenced in qryPr1Opt with Param1 from cmbParam1
    Param1Opt = CurrentDb.OpenRecordset("SELECT tblPr1Opt.Option FROM tblPr1Opt " &_
        "WHERE Param1 = '" & cmbParam1 & "';")
    
    'create recordset of tblOption.Option(s) referenced in qryPr2Opt with Param2 from cmbParam2
    Param2Opt = CurrentDb.OpenRecordset("SELECT tblPr2Opt.Option FROM tblPr2Opt " &_
        "WHERE Param2 = '" & cmbParam2 & "';")
    
    'create recordset of tblOption.Option(s) in qryOptOvrlp with Param2 and Param1 from form
    OverlapOpt = CurrentDb.OpenRecordset("SELECT qryOptOvrlp.Option FROM qryOptOvrlp " &_
        "WHERE Param1 = '" & cmbParam1 & "' AND Param2 = '" & cmbParam2 & "';")
    
    OverlapNum = Param1Num + Param2Num
    
    'Steps remaining:
    '1. Get Param1Opt and Param2Opt to only include Options not in overlap
    For Each oOpt In OverlapOpt
        For Each aOpt In Param1Opt
            If aOpt.Value = oOpt.Value Then
                'filter this record out of Param1Opt
            End If
        Next aOpt
        For Each gOpt In Param2Opt
            If gOpt.Value = oOpt.Value Then
                'filter this record out of Param2Opt
            End If
        Next gOpt
    Next oOpt
    
    '2. Get the data in Param1Opt, Param2Opt and OverlapOpt, as well as their
    'corresponding Nums to be accessible/editable in other functions/subs
End Function

剩余步骤的实现指导 #

步骤1：过滤重叠记录的高效方法

首先纠正一个细节：DAO Recordset不能直接用For Each遍历单个记录的字段值，而且先查全量再过滤的效率不如直接用SQL一步到位。这里提供两种可行方案：

方案A：用SQL直接查询非重叠记录

不需要先获取全量再过滤，直接通过SQL排除重叠项，代码更简洁高效：

' 仅属于Param1的Options（排除与Param2重叠的项）
Set Param1Opt = CurrentDb.OpenRecordset( _
    "SELECT po.Option FROM tblPr1Opt po " & _
    "WHERE po.Param1 = '" & cmbParam1 & "' " & _
    "AND po.Option NOT IN ( " & _
        "SELECT Option FROM qryOptOvrlp " & _
        "WHERE Param1 = '" & cmbParam1 & "' AND Param2 = '" & cmbParam2 & "' " & _
    ");")

' 仅属于Param2的Options（排除与Param1重叠的项）
Set Param2Opt = CurrentDb.OpenRecordset( _
    "SELECT po.Option FROM tblPr2Opt po " & _
    "WHERE po.Param2 = '" & cmbParam2 & "' " & _
    "AND po.Option NOT IN ( " & _
        "SELECT Option FROM qryOptOvrlp " & _
        "WHERE Param1 = '" & cmbParam1 & "' AND Param2 = '" & cmbParam2 & "' " & _
    ");")

方案B：用集合存储重叠值，遍历过滤Recordset

如果必须用Recordset操作，先把重叠的Option值存入集合，再遍历删除匹配项：

Dim overlapValues As New Collection
' 先将重叠的Option值存入集合（用字符串做键避免重复）
OverlapOpt.MoveFirst
Do While Not OverlapOpt.EOF
    overlapValues.Add OverlapOpt!Option.Value, Key:=CStr(OverlapOpt!Option.Value)
    OverlapOpt.MoveNext
Loop

' 过滤Param1Opt
Param1Opt.MoveFirst
Do While Not Param1Opt.EOF
    On Error Resume Next ' 忽略键不存在的错误
    overlapValues.Item(CStr(Param1Opt!Option.Value))
    If Err.Number = 0 Then ' 若当前项在重叠集合中
        Param1Opt.Delete ' 删除该记录
    Else
        Param1Opt.MoveNext
    End If
    On Error GoTo 0
Loop

' 过滤Param2Opt的逻辑和上面一致
Param2Opt.MoveFirst
Do While Not Param2Opt.EOF
    On Error Resume Next
    overlapValues.Item(CStr(Param2Opt!Option.Value))
    If Err.Number = 0 Then
        Param2Opt.Delete
    Else
        Param2Opt.MoveNext
    End If
    On Error GoTo 0
Loop

注意：使用Delete方法时，Recordset必须是可更新的（比如基于基础表的查询，而非不可更新的聚合查询）。

步骤2：让数据在其他函数中可访问

要让Param1Opt、Param2Opt、OverlapOpt以及计数变量在其他子程序/函数中可用，需要将它们声明为模块级变量，而非函数内部的局部变量。在表单模块的顶部（所有函数之外）添加声明：

' 模块级变量，表单内所有函数均可访问
Dim Param1Opt As DAO.Recordset, Param2Opt As DAO.Recordset, OverlapOpt As DAO.Recordset
Dim Param1Num As Integer, Param2Num As Integer, OverlapNum As Integer

然后在SetOptions函数中，用Set关键字为Recordset赋值（之前的代码缺少Set会报错）：

Set Param1Opt = CurrentDb.OpenRecordset(...)
Set Param2Opt = CurrentDb.OpenRecordset(...)
Set OverlapOpt = CurrentDb.OpenRecordset(...)

另外，计数可以直接用Recordset的RecordCount属性获取：

Param1Num = Param1Opt.RecordCount
Param2Num = Param2Opt.RecordCount
OverlapNum = OverlapOpt.RecordCount

额外注意事项 #

• 避免SQL注入：如果cmbParam1或cmbParam2的值可能包含单引号，建议用DAO QueryDef参数查询代替直接拼接字符串。
• 实时更新：可在复选框的AfterUpdate事件中调用SetOptions函数，触发分组的重新计算。

内容的提问来源于stack exchange，提问作者Isaac Reefman