Excel·VBA单元格区域数据对比差异标记颜色

之前的一篇博客《Excel·VBA单元格重复值标记颜色》，是对重复的整行标记颜色
而本文是按行对比2个单元格区域的数据，并对有差异的区域（一个单元格区域有的，而另一个单元格区域没有的）标记颜色，且只要存在任意1个字符不同的，则标记颜色

单元格区域数据对比标色

代码写为自定义函数使用更为方便，并使用 Union 方法在每个单元格区域判断结束后统一标色

Function 单元格区域数据对比标色(ByVal rng1 As Range, ByVal rng2 As Range)'2个单元格区域数据按行对比，1个区域中有另1个区域中无则标色，每行中任意1个字符不同则标色Dim dict1 As Object, dict2 As Object, delimiter$, color_index&, i&, j&, temp$, k, color_rng As RangeSet dict1 = CreateObject("scripting.dictionary"): delimiter = Chr(28)Set dict2 = CreateObject("scripting.dictionary"): color_index = 6  '标记黄色For i = 1 To rng1.Rows.Count  'rng1写入字典temp = ""For j = 1 To rng1.Columns.Counttemp = temp & delimiter & rng1.Cells(i, j).ValueNextIf Not dict1.Exists(temp) ThenSet dict1(temp) = rng1.Rows(i)ElseSet dict1(temp) = Union(dict1(temp), rng1.Rows(i))End IfNextFor i = 1 To rng2.Rows.Count  'rng2写入字典temp = ""For j = 1 To rng2.Columns.Counttemp = temp & delimiter & rng2.Cells(i, j).ValueNextIf Not dict2.Exists(temp) ThenSet dict2(temp) = rng2.Rows(i)ElseSet dict2(temp) = Union(dict2(temp), rng2.Rows(i))End IfNextFor Each k In dict1.keys  '遍历dict1，判断所有键在dict2中是否存在，不存在则写入标色区域color_rngIf Not dict2.Exists(k) ThenIf color_rng Is Nothing ThenSet color_rng = dict1(k)ElseSet color_rng = Union(color_rng, dict1(k))End IfEnd IfNext'Union无法跨工作表使用，故先对color_rng标色1次If Not color_rng Is Nothing Then color_rng.Interior.ColorIndex = color_index: Set color_rng = NothingFor Each k In dict2.keys  '遍历dict2，判断所有键在dict1中是否存在If Not dict1.Exists(k) ThenIf color_rng Is Nothing ThenSet color_rng = dict2(k)ElseSet color_rng = Union(color_rng, dict2(k))End IfEnd IfNextIf Not color_rng Is Nothing Then color_rng.Interior.ColorIndex = color_index: Set color_rng = NothingDebug.Print "单元格区域数据对比标色，完成"
End Function

举例

Sub 测试()Dim rng1 As Range, rng2 As RangeSet rng1 = Worksheets("表1").[a1].CurrentRegionSet rng2 = Worksheets("表2").[a1].CurrentRegiona = 单元格区域数据对比标色(rng1, rng2)
End Sub