Access VBA列表框选中项匹配另一表Group值遇运行时错误3265求解

报错3265的核心原因 #

你遇到的报错是以下几个错误写法叠加导致的：

• ReDim语法不符合VBA规范：ReDim ArrCT(ct = 0 To Me.testbutton.ItemsSelected.Count - 1)中的ct=0是布尔运算，会被自动转为数值作为数组下界，最终数组索引和你后续赋值的下标不匹配，导致读取数组值错误。
• 循环索引调用错误：第二个循环里的变量x是列表框选中项的行索引，不是你自定义的ArrCT数组的下标，直接调用ArrCT(x)会触发数组越界，读取到不存在的数组元素。
• 记录集未做遍历处理：你打开MasterList记录集后，指针默认停在第一条记录，整个匹配过程只会和第一条的Item值比对，即使字段名正确也只能拿到第一条的Group值，若记录集为空还会额外触发报错。

更简便的实现方案 #

针对你这种单字段匹配的场景，直接用Access内置的DLookup函数即可完成查表需求，不需要手动打开记录集、做循环匹配，代码逻辑更简洁，哪怕数据量是样例的20倍也完全满足性能要求：

Dim v As Variant, groupArr() As String
Dim selectCount As Integer
selectCount = Me.testbutton.ItemsSelected.Count
' 无选中项直接退出
If selectCount = 0 Then Exit Sub
ReDim groupArr(0 To selectCount - 1)
Dim i As Integer: i = 0
For Each v In Me.testbutton.ItemsSelected
    ' 直接查询对应Item的Group层级，替换单引号避免查询语法错误，Nz处理匹配不到的场景
    groupArr(i) = Nz(DLookup("Group", "MasterList", "Item='" & Replace(Me.testbutton.ItemData(v), "'", "''") & "'"), "未匹配")
    i = i + 1
Next v
' 后续直接调用groupArr数组即可获取所有选中项对应的Group值

原有逻辑的修复方案 #

如果要沿用记录集的实现思路，建议先把MasterList的Item和Group映射关系存入字典，匹配效率更高，修改后的代码如下：

' 提前加载映射关系到字典，查询效率为O(1)
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Item, Group FROM MasterList")
Do While Not rs.EOF
    dict(rs!Item.Value) = rs!Group.Value
    rs.MoveNext
Loop
rs.Close
Set rs = Nothing

' 处理选中项
Dim v As Variant, groupArr() As String
ReDim groupArr(0 To Me.testbutton.ItemsSelected.Count - 1)
Dim i As Integer: i = 0
For Each v In Me.testbutton.ItemsSelected
    groupArr(i) = dict(Me.testbutton.ItemData(v))
    i = i + 1
Next v

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