VBA使用自定义区域数组做值比对时报Error 9下标越界错误

问题背景 #

从工作表两个单元格区域分别取值生成两个数组，需生成第三个数组存储数组1（完整列表）存在、数组2（不完整列表）缺失的值。参考网络公开逻辑编写代码时，使用Array()函数赋值常量数组运行正常，但替换为自定义的单元格区域读取数组后，触发Error 9: Subscript out of range（下标越界）报错，仅替换变量名无法解决。

问题复现代码 #

动态不完整列表数组（B列数据，数组2） #

Dim iListaIncompleta() As Variant 
Dim iCountLI As Long 
Dim iElementLI As Long
iCountLI = Range("B1").End(xlDown).Row
ReDim iListaIncompleta(iCountLI)
For iElementLI = 1 To iCountLI 
iListaIncompleta(iElementLI - 1) = Cells(iElementLI, 2).Value
Next iElementLI

固定完整列表数组（A1:A7区域，数组1） #

Dim iListaCompleta() As Variant 
Dim iElementLC As Long
iListaCompleta = Range("A1:A7")

参考的原差异提取逻辑（常量数组下运行正常） #

Dim v1 As Variant, v2 As Variant, v3 As Variant
Dim coll As Collection
Dim i As Long

' 测试用常量数组
v1 = Array("Bob", "Alice", "Thor", "Anna") '完整列表
v2 = Array("Bob", "Thor") '不完整列表

Set coll = New Collection

For i = LBound(v1) To UBound(v1)
    If v1(i) <> 0 Then
    coll.Add v1(i), v1(i) '过滤0值
    End If
Next i

For i = LBound(v2) To UBound(v2)
    On Error Resume Next
    coll.Add v2(i), v2(i)
    If Err.Number <> 0 Then
        coll.Remove v2(i)
    End If
    If coll.Exists(v2(i)) Then 
        coll.Remove v2(i)
    End If
    On Error GoTo 0
Next i

ReDim v3(LBound(v1) To (coll.Count) - 1) 

For i = LBound(v3) To UBound(v3)
    v3(i) = coll(i + 1) '集合为1基数组
    Debug.Print v3(i)
Next i
End Sub

报错核心原因 #

• 数组维度规则不匹配：
  • Array()函数生成的是一维0基数组，用单下标arr(i)即可访问元素
  • 直接通过arr = Range("A1:A7")从单元格区域赋值生成的数组是二维数组，第一维对应行、第二维对应列，哪怕只有1列数据，也必须用arr(行下标, 列下标)的双下标格式访问，直接用单下标取值就会触发下标越界
• 其他隐含问题：
  • 原自定义iListaIncompleta数组长度冗余：iCountLI行数据对应iCountLI个元素，原代码ReDim iListaIncompleta(iCountLI)会生成下标0~iCountLI共iCountLI+1个元素，最后一位为空值
  • 参考代码未处理集合为空的边界场景：当两数组完全重合时coll.Count=0，ReDim v3(0 To -1)会生成无效数组触发报错
  • 参考代码存在冗余判断：重复判断集合项是否存在，逻辑多余

修正后可运行代码 #

Sub ExtractMissingValues()
    Dim iListaIncompleta() As Variant, iListaCompleta As Variant
    Dim iCountLI As Long, i As Long
    Dim coll As Collection
    Dim v3 As Variant
    
    ' 读取B列动态不完整列表（一维0基数组）
    iCountLI = Range("B1").End(xlDown).Row
    ReDim iListaIncompleta(0 To iCountLI - 1) '修正数组长度，匹配实际行数
    For i = 1 To iCountLI
        iListaIncompleta(i - 1) = Cells(i, 2).Value
    Next i
    
    ' 读取A1:A7完整列表（二维数组，行从1到7，列固定为1）
    iListaCompleta = Range("A1:A7").Value
    
    Set coll = New Collection
    
    ' 遍历完整列表写入集合，自动去重
    For i = LBound(iListaCompleta, 1) To UBound(iListaCompleta, 1)
        ' 跳过空值、错误值，key统一转字符串避免格式不匹配
        If Not IsError(iListaCompleta(i, 1)) And Trim(iListaCompleta(i, 1)) <> "" Then
            On Error Resume Next
            coll.Add Item:=CStr(iListaCompleta(i, 1)), Key:=CStr(iListaCompleta(i, 1))
            On Error GoTo 0
        End If
    Next i
    
    ' 遍历不完整列表，移除集合中已存在的项
    For i = LBound(iListaIncompleta) To UBound(iListaIncompleta)
        If Not IsError(iListaIncompleta(i)) And Trim(iListaIncompleta(i)) <> "" Then
            On Error Resume Next
            coll.Remove CStr(iListaIncompleta(i))
            On Error GoTo 0
        End If
    Next i
    
    ' 边界处理：无缺失值直接退出
    If coll.Count = 0 Then
        Debug.Print "未检测到缺失值"
        Exit Sub
    End If
    
    ' 生成结果数组
    ReDim v3(0 To coll.Count - 1)
    For i = 0 To coll.Count - 1
        v3(i) = coll(i + 1)
        Debug.Print "缺失值：" & v3(i)
    Next i
    
    ' 后续可按需将v3写入工作表指定区域
End Sub

关键修正点 #

• 二维数组遍历明确指定列下标：访问区域赋值的数组时，固定取第二维下标1（对应第一列）
• 修正动态数组长度，避免冗余空元素
• 简化集合操作逻辑，去掉重复的存在性判断
• 增加空值、错误值、空集合的边界处理，避免特殊场景报错
• 集合的key统一转为字符串，规避数字/文本格式不一致导致的匹配失败

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