VBA向Collection添加项时触发Error 13类型不匹配错误

这个错误和跨工作表操作没有关系，是代码本身的逻辑问题导致的：

• Collection的key参数类型不符合要求：VBA规定Collection对象的key必须为字符串类型，你直接将单元格读取到的值（可能是数值、逻辑值等非字符串类型）作为key传入，会直接触发错误13（类型不匹配），这就是你标注的那行Add语句报错的直接原因。这也符合你遇到的现象：去掉Add的第二个参数（即不传入key）后代码不再报错，但失去了key的唯一性校验能力，后续差集判断完全失效。
• 数组维度不统一：Array1通过单元格区域直接赋值，是VBA默认的二维数组（结构为[行索引, 列索引]，即使是单列区域也会保留二维结构）；但你手动构造的Array2被ReDim Array2(iCountLI)定义为一维数组，后续遍历Array2时用Array2(i, 1)的二维语法取值，本身就会触发维度错误。
• 调用了Collection不存在的方法：VBA原生Collection对象没有Exists方法，这是Dictionary对象的成员，你原来代码里的coll.exists调用即使绕过前面的错误，也会触发"对象不支持该属性或方法"的报错。
• 跨表取值引用不明确：构造Array2时Cells对象没有显式指定所属工作表，跨表场景下会读取当前激活工作表的B列数据，会直接取错值。

核心修复逻辑：

• 所有传入Collection作为key的值统一用CStr()转为字符串，避免类型不匹配
• 两个数组都直接通过单元格区域赋值生成，统一为二维结构，避免手动循环构造数组的维度错误，同时显式指定所有Range/Cells所属的工作表，避免跨表取错值
• 替换原有的冗余差集逻辑：先把Array2的所有值存入排除集合，再遍历Array1，通过错误捕获判断值是否在排除集合中，仅保留不存在的值，同时移除对不存在的Exists方法的调用

修正后完整代码：

Sub CrearArreglos()
    Dim Array1 As Variant, Array2 As Variant
    Dim collExclude As Collection, collResult As Collection
    Dim v3 As Variant
    Dim i As Long, lastRow As Long, errNum As Long
    Dim tmpVal As String
    
    ' 读取Array2：显式指定Sheet2，直接取单元格值生成二维数组，避免手动循环出错
    With Sheets("Sheet2")
        If IsEmpty(.Range("B3").Value) Then
            ReDim Array2(1 To 1, 1 To 1)
        Else
            lastRow = .Range("B3").End(xlDown).Row
            Array2 = .Range("B3:B" & lastRow).Value
        End If
    End With
    
    ' 读取Array1：直接取Sheet1的指定区域生成二维数组
    Array1 = Worksheets("Sheet1").Range("BD4:BD10").Value
    
    ' 构建排除集合：存入Array2所有非空值，自动去重
    Set collExclude = New Collection
    On Error Resume Next
    For i = LBound(Array2, 1) To UBound(Array2, 1)
        If Not IsEmpty(Array2(i, 1)) Then
            collExclude.Add Item:=CStr(Array2(i, 1)), Key:=CStr(Array2(i, 1))
        End If
    Next i
    On Error GoTo 0
    
    ' 遍历Array1，提取不在Array2中的值存入结果集合
    Set collResult = New Collection
    For i = LBound(Array1, 1) To UBound(Array1, 1)
        If Not IsEmpty(Array1(i, 1)) And Array1(i, 1) <> 0 Then
            ' 尝试从排除集合取当前值，取不到说明值不存在于Array2
            On Error Resume Next
            Err.Clear
            tmpVal = collExclude(CStr(Array1(i, 1)))
            errNum = Err.Number
            On Error GoTo 0
            
            If errNum <> 0 Then
                ' 加入结果集合，key转字符串避免Array1内部重复值
                On Error Resume Next
                collResult.Add Item:=Array1(i, 1), Key:=CStr(Array1(i, 1))
                On Error GoTo 0
            End If
        End If
    Next i
    
    ' 将结果集合转为数组
    If collResult.Count > 0 Then
        ReDim v3(0 To collResult.Count - 1)
        For i = 0 To UBound(v3)
            v3(i) = collResult(i + 1)
            Debug.Print v3(i)
        Next
    Else
        ReDim v3(0 To 0)
        v3(0) = Empty
    End If
End Sub

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