Excel VBA按唯一列合并重复行及运行时错误13/1004解决咨询

问题1：运行时错误13（类型不匹配）的原因与解决 #

• 该错误大概率是源数据中存在错误值（如#N/A、#DIV/0!等）导致的。你当前代码直接判断sh1.Cells(i, j) <> ""，如果单元格是错误值，无法直接和字符串做比较，就会触发类型不匹配。数据能正常输出是因为错误出现在循环后半段，前面的逻辑已经完成了大部分数据写入。
• 解决方法是在判断单元格内容前，先加一层IsError判断过滤错误值。

问题2：修改为按K列去重的调整方案 #

你之前只修改查找范围为K:K会报错，是因为两处疏漏：

1. 查找的匹配值没有同步改为K列的单元格内容，还是在取A列的值匹配K列，逻辑不成立
2. 粘贴整行时如果把粘贴起点改到K列，复制的整行数据宽度和K列开始的粘贴区域宽度不匹配，就会报1004错误，粘贴起点保持在A列即可，不影响按K列去重的逻辑
   另外还要把原代码里统计最后一行的判断列从A列改成K列，避免漏统计A列空但K列有值的行。

修改后的完整代码 #

Sub Merge_Duplicate()

    Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long, f As Range, g As Range

    Application.ScreenUpdating = False

    Set sh1 = Worksheets(2)
    Set sh2 = Worksheets(3)

    sh2.Cells.ClearContents
    sh1.Rows(1).Copy sh2.Rows(1)

    ' 统计最后一行的列从A改为K，避免漏行
    For i = 2 To sh1.Range("K" & Rows.Count).End(xlUp).Row
        For j = 2 To sh1.Cells(i, Columns.Count).End(xlToLeft).Column
            ' 先判断单元格不是错误值再判断非空，解决错误13
            If Not IsError(sh1.Cells(i, j)) And sh1.Cells(i, j) <> "" Then
                ' 查找范围改为K列，查找值改为当前行K列内容，实现按K列去重
                Set f = sh2.Range("K:K").Find(sh1.Cells(i, "K"), , xlValues, xlWhole)
                If Not f Is Nothing Then
                    Set g = sh2.Rows(1).Find(sh1.Cells(1, j), , xlValues, xlWhole)
                    If Not g Is Nothing Then
                        sh2.Cells(f.Row, g.Column) = sh1.Cells(i, j)
                    End If
                Else
                    ' 粘贴起点保持A列，整行粘贴不会丢失内容，也不会报大小不匹配错误
                    sh1.Rows(i).Copy sh2.Range("A" & sh2.Range("K" & Rows.Count).End(xlUp).Row + 1)
                End If
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub

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