Excel VBA转Access VBA：Filter函数替代方案咨询

Access VBA没有原生的Filter函数，需要自行编写自定义模块实现类似功能，且可以通过**字典（Dictionary）**优化性能，解决逐元素比对速度慢的问题。

核心思路 #

利用字典的哈希查找特性（查找时间复杂度O(1)）替代双重循环遍历，大幅提升大数组下的比对效率：

1. 将其中一个数组的所有元素存入字典的键（键具有唯一性）
2. 遍历另一个数组，通过字典快速判断元素是否存在，筛选出差异项

自定义实现代码 #

以下是可直接复用的模块代码，能分别找出「数组A有但数组B没有」和「数组B有但数组A没有」的元素：

' 可选择引用Microsoft Scripting Runtime，或使用CreateObject创建字典
Function CompareArrays(arrA As Variant, arrB As Variant) As Variant
    Dim dictA As Object, dictB As Object
    Dim diffA As Variant, diffB As Variant
    Dim i As Long, temp As Variant
    Dim result As Variant
    
    ' 初始化字典
    Set dictA = CreateObject("Scripting.Dictionary")
    Set dictB = CreateObject("Scripting.Dictionary")
    
    ' 将数组A元素存入字典
    For i = LBound(arrA) To UBound(arrA)
        temp = Trim(arrA(i)) ' 去除首尾空格，按需调整
        If Not dictA.Exists(temp) Then
            dictA.Add temp, i
        End If
    Next i
    
    ' 将数组B元素存入字典，同时筛选A中没有的元素
    ReDim diffB(0 To 0)
    For i = LBound(arrB) To UBound(arrB)
        temp = Trim(arrB(i))
        If Not dictB.Exists(temp) Then
            dictB.Add temp, i
        End If
        If Not dictA.Exists(temp) Then
            diffB(UBound(diffB)) = temp
            ReDim Preserve diffB(0 To UBound(diffB) + 1)
        End If
    Next i
    If UBound(diffB) > 0 Then ReDim Preserve diffB(0 To UBound(diffB) - 1)
    
    ' 筛选B中没有的A元素
    ReDim diffA(0 To 0)
    For i = LBound(arrA) To UBound(arrA)
        temp = Trim(arrA(i))
        If Not dictB.Exists(temp) Then
            diffA(UBound(diffA)) = temp
            ReDim Preserve diffA(0 To UBound(diffA) + 1)
        End If
    Next i
    If UBound(diffA) > 0 Then ReDim Preserve diffA(0 To UBound(diffA) - 1)
    
    ' 返回差异结果（可按需调整返回格式，比如组合成二维数组）
    result = Array(diffA, diffB)
    CompareArrays = result
    
    ' 释放对象
    Set dictA = Nothing
    Set dictB = Nothing
End Function

使用示例 #

Sub TestCompare()
    Dim arr1 As Variant, arr2 As Variant
    Dim differences As Variant
    Dim onlyInArr1 As Variant, onlyInArr2 As Variant
    
    arr1 = Array("法规A", "法规B", "法规C")
    arr2 = Array("法规B", "法规C", "法规D")
    
    differences = CompareArrays(arr1, arr2)
    onlyInArr1 = differences(0)
    onlyInArr2 = differences(1)
    
    ' 输出结果到立即窗口
    Debug.Print "仅在数组1中的法规："
    For Each item In onlyInArr1
        Debug.Print "- " & item
    Next
    Debug.Print "仅在数组2中的法规："
    For Each item In onlyInArr2
        Debug.Print "- " & item
    Next
End Sub

性能优化说明 #

• 避免了传统双重循环的O(n²)时间复杂度，大数组（比如上千元素）下速度提升显著
• Trim()处理是为了避免空格导致的误判，可根据实际数据情况移除或调整
• 无需额外引用库，用CreateObject即可创建字典，兼容性更强

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