VBA快速对比数据行

实例需求：对于存在多行数据（示例中为双行）的项目，对比同一个项目的每列数据，高亮显示数据不同的单元格。

示例代码如下。

Function GetDiff(ByRef rng1 As Range, ByRef rng2 As Range) As Range
    Dim i As Long
    For i = 1 To rng1.Cells.Count
        If rng1.Cells(i).Value <> rng2.Cells(i).Value Then
            Set GetDiff = MergeRng(GetDiff, Application.Union(rng1.Cells(i), rng2.Cells(i)))
        End If
    Next
End Function
Function MergeRng(ByRef RngAll As Range, ByRef RngSub As Range) As Range
    If RngAll Is Nothing Then
        Set RngAll = RngSub
    ElseIf Not RngSub Is Nothing Then
        Set RngAll = Application.Union(RngAll, RngSub)
    End If
    Set MergeRng = RngAll
End Function

【代码解析】
第1~8行代码为自定义函数过程MergeRng，参数为两个Range对象，RngAll用于保存合并结果的Range对象。
第2行代码判断RngAll是否为空。如果为空，则第3行代码将RngSub复制给RngAll，否则第5行代码合并两个Range对象。
第7行代码设置自定义函数的返回值（Range对象）。
第9~16行代码对比两个Range对象，返回值Range对象。
第11~15行代码循环遍历rng1中每个单元格。
第12行代码判断两个单元格的值是否相等。
如果两个单元格内容不同，那么第13行代码将两个单元格合并到返回值中。

Sub Demo()
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey, diffRng As Range
    Dim rng1 As Range, rng2 As Range, arrData
    Set objDic = CreateObject("scripting.dictionary")
    Set rngData = Range("A1").CurrentRegion
    arrData = rngData.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 1)
        If objDic.exists(sKey) Then
            Set objDic(sKey) = Application.Union(objDic(sKey), Cells(i, 1))
        Else
            Set objDic(sKey) = Cells(i, 1)
        End If
    Next i
    For Each sKey In objDic.Keys
        If objDic(sKey).Cells.Count > 1 Then 
            Set rng1 = Application.Intersect(rngData, objDic(sKey).Cells(1).EntireRow)
            If objDic(sKey).Areas.Count = 1 Then
                Set rng2 = Application.Intersect(rngData, objDic(sKey).Cells(2).EntireRow)
            Else
                Set rng2 = Application.Intersect(rngData, objDic(sKey).Areas(2).Cells(1).EntireRow)
            End If
            Set diffRng = MergeRng(diffRng, GetDiff(rng1, rng2))
        End If
    Next
    If Not diffRng Is Nothing Then
        diffRng.Interior.ColorIndex = 6
    End If
End Sub

【代码解析】
第5行代码创建字典对象。
第6行代码获取活动工作表中的数据区域。
第7行代码将数据读取到数组中。
第8~15行代码循环遍历数据行。
第7行代码读取第一列的项目名称。
第10行代码判断项目是否存在于字典对象中。
如果存在，则第11行代码合并Range对象，否则第13行代码将项目添加到字典对象中。
第16~26行代码循环遍历字典对象。
第17行代码判断每个项目的单元格数量，如果满足条件，说明该项目有多行数据（后续代码只考虑双行数据）。
第18行代码获取当前项目的数据行。
第19~23行代码获取第2个数据行区域。
第24行代码获取两个数据的差异区域。
如果差异区域不为空，那么第28行代码高亮标记相关区域。