VBA提取唯一ID并拼接对应值时触发类型不匹配错误(Error13)

一、「类型不匹配」错误原因及解决 #

出现该错误的核心原因：

• Dictionary的键（Key）不支持Variant类型的空单元格或错误值（如#N/A、#VALUE!），原代码中inputArray(1, k)可能包含这类值，导致Exists方法调用失败。
• 原代码使用WorksheetFunction.Transpose转置数组，大行数场景下易出现维度异常，进一步触发类型错误。

二、无需临时列的优化实现 #

直接读取非连续列的数组进行处理，无需复制到临时列，同时解决类型匹配问题，完整代码如下：

Sub MergeByUniqueID()
    Dim defendersSht As Worksheet
    Dim phishLR As Long
    Dim dc As Object
    Dim idArr As Variant, valArr As Variant
    Dim k As Long
    Dim currentID As String, currentVal As String
    
    ' 替换为你的实际工作表对象，或者通过名称获取
    Set defendersSht = ThisWorkbook.Worksheets("你的工作表名")
    ' 假设eidPhishCN是ID列的列号，phishAlarmCN是需拼接值的列号，自行定义
    Dim eidPhishCN As Long, phishAlarmCN As Long
    eidPhishCN = 2 ' 示例：第2列为ID列
    phishAlarmCN = 5 ' 示例：第5列为需拼接的值列
    
    ' 获取数据最后一行
    phishLR = defendersSht.Cells.Find(what:="*", After:=defendersSht.Range("A1"), _
                LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, MatchCase:=False).Row
    
    ' 直接读取两列的数组，无需临时列
    idArr = defendersSht.Range(defendersSht.Cells(2, eidPhishCN), defendersSht.Cells(phishLR, eidPhishCN)).Value2
    valArr = defendersSht.Range(defendersSht.Cells(2, phishAlarmCN), defendersSht.Cells(phishLR, phishAlarmCN)).Value2
    
    ' 创建Dictionary对象
    Set dc = CreateObject("Scripting.Dictionary")
    dc.CompareMode = vbTextCompare ' 不区分大小写，按需改为vbBinaryCompare启用区分
    
    ' 循环处理每一行数据
    For k = LBound(idArr, 1) To UBound(idArr, 1)
        ' 处理ID：空值/错误值转为可识别的字符串Key
        If IsError(idArr(k, 1)) Then
            currentID = "错误ID_" & k
        ElseIf IsEmpty(idArr(k, 1)) Then
            currentID = "空ID_" & k
        Else
            currentID = CStr(idArr(k, 1)) ' 强制转为字符串，避免类型冲突
        End If
        
        ' 处理需拼接的值：空值/错误值转为空字符串
        currentVal = IIf(IsError(valArr(k, 1)) Or IsEmpty(valArr(k, 1)), "", CStr(valArr(k, 1)))
        
        ' 更新Dictionary：存在则拼接，不存在则添加
        If dc.Exists(currentID) Then
            dc(currentID) = dc(currentID) & ", " & currentVal
        Else
            dc.Add currentID, currentVal
        End If
    Next k
    
    ' 清空原数据区域（从第2行开始，保留表头）
    defendersSht.Range(defendersSht.Cells(2, eidPhishCN), defendersSht.Cells(phishLR, eidPhishCN)).ClearContents
    defendersSht.Range(defendersSht.Cells(2, phishAlarmCN), defendersSht.Cells(phishLR, phishAlarmCN)).ClearContents
    
    ' 将处理结果写入工作表
    If dc.Count > 0 Then
        defendersSht.Cells(2, eidPhishCN).Resize(dc.Count, 1).Value = Application.Transpose(dc.Keys)
        defendersSht.Cells(2, phishAlarmCN).Resize(dc.Count, 1).Value = Application.Transpose(dc.Items)
    End If
    
    ' 释放对象，避免内存泄漏
    Set dc = Nothing
    Set defendersSht = Nothing
End Sub

三、关键优化说明 #

• 取消临时列：分别读取ID列和值列的数组idArr、valArr，通过行索引k对应匹配，无需复制数据到临时列，提升执行效率。
• 解决类型冲突：将ID强制转为字符串，对空值/错误ID生成唯一标识，确保Dictionary的Key类型合法。
• 稳定的数组操作：使用Application.Transpose替代WorksheetFunction.Transpose，避免大行数场景下的转置异常。
• 明确对象绑定：所有Range、Cells操作均绑定指定工作表，避免跨表引用错误。

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