带条件合并单元格区域唯一值至同行区域的VBA报错问题

问题1：空区域触发Type Mismatch错误 #

根源分析 #

当目标区域（如C7:C8）全为空时，arrDC会成为仅包含空值的数组或处于Empty状态，此时对空值执行Application.Match会返回错误变体类型，触发类型不匹配。

解决方案 #

在执行匹配前添加双重校验：先判断当前值非空，再过滤目标数组中的空值，避免对空数组执行匹配：

Dim tempDC As Variant
If Not IsEmpty(arr(i, 3)) Then
    ' 过滤arrDC中的空值，生成有效数据集
    tempDC = Filter(Application.Transpose(arrDC), "", False)
    ' 仅当过滤后数组有数据时执行匹配
    If UBound(tempDC) >= 0 Then
        mtch = Application.Match(arr(i, 3), tempDC, 0)
    Else
        mtch = 0 ' 标记为未找到
    End If
Else
    mtch = 0 ' 空值直接跳过匹配逻辑
End If

问题2：结果顶部出现空行 #

根源分析 #

空单元格的值被纳入唯一值收集逻辑，最终写入工作表时会生成空行。

解决方案 #

在收集唯一值的全流程中过滤空值：

1. 遍历单元格/数组时，仅处理非空且非空白的内容
2. 写入结果前确保仅输出有效数据

示例修改逻辑：

' 收集唯一值时过滤空值
If mtch = 0 And Not IsEmpty(arr(i, 3)) And Trim(arr(i, 3)) <> "" Then
    ' 将有效值添加到结果数组
    ReDim Preserve resultArr(1 To UBound(resultArr) + 1)
    resultArr(UBound(resultArr)) = arr(i, 3)
End If

' 写入工作表时避免空输出
If UBound(resultArr) >= 1 Then
    targetRange.Resize(UBound(resultArr)).Value = Application.Transpose(resultArr)
End If

完整优化代码示例 #

Sub MergeUniqueValues_Fixed()
    Dim ws As Worksheet
    Dim sourceRng As Range
    Dim arr As Variant, arrDC As Variant
    Dim resultArr() As Variant
    Dim i As Long, mtch As Variant
    Dim tempDC As Variant
    
    Set ws = ActiveSheet
    Set sourceRng = ws.Range("C7:C8,B9:B10") ' 示例源区域
    arr = sourceRng.Value
    arrDC = ws.Range("D:D").Value ' 假设对比区域为D列
    ReDim resultArr(1 To 0) ' 初始化结果数组
    
    For i = 1 To UBound(arr, 1)
        ' 处理空区域匹配报错
        If Not IsEmpty(arr(i, 1)) Then
            tempDC = Filter(Application.Transpose(arrDC), "", False)
            If UBound(tempDC) >= 0 Then
                mtch = Application.Match(arr(i, 1), tempDC, 0)
            Else
                mtch = 0
            End If
        Else
            mtch = 0
        End If
        
        ' 过滤空值，避免结果出现空行
        If mtch = 0 And Not IsEmpty(arr(i, 1)) And Trim(arr(i, 1)) <> "" Then
            ReDim Preserve resultArr(1 To UBound(resultArr) + 1)
            resultArr(UBound(resultArr)) = arr(i, 1)
        End If
    Next i
    
    ' 输出结果到目标区域（示例为E1开始）
    If UBound(resultArr) >= 1 Then
        ws.Range("E1").Resize(UBound(resultArr)).Value = Application.Transpose(resultArr)
    End If
End Sub

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