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

之前的一篇博客《Excel·VBA单元格重复值标记颜色》,是对重复的整行标记颜色

而本文是按行对比2个单元格区域的数据,并对有差异的区域(一个单元格区域有的,而另一个单元格区域没有的)标记颜色,且只要存在任意1个字符不同的,则标记颜色

单元格区域数据对比标色

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

vbnet 复制代码
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 Range
    Set 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.Count
            temp = temp & delimiter & rng1.Cells(i, j).Value
        Next
        If Not dict1.Exists(temp) Then
            Set dict1(temp) = rng1.Rows(i)
        Else
            Set dict1(temp) = Union(dict1(temp), rng1.Rows(i))
        End If
    Next
    For i = 1 To rng2.Rows.Count  'rng2写入字典
        temp = ""
        For j = 1 To rng2.Columns.Count
            temp = temp & delimiter & rng2.Cells(i, j).Value
        Next
        If Not dict2.Exists(temp) Then
            Set dict2(temp) = rng2.Rows(i)
        Else
            Set dict2(temp) = Union(dict2(temp), rng2.Rows(i))
        End If
    Next
    For Each k In dict1.keys  '遍历dict1,判断所有键在dict2中是否存在,不存在则写入标色区域color_rng
        If Not dict2.Exists(k) Then
            If color_rng Is Nothing Then
                Set color_rng = dict1(k)
            Else
                Set color_rng = Union(color_rng, dict1(k))
            End If
        End If
    Next
    'Union无法跨工作表使用,故先对color_rng标色1次
    If Not color_rng Is Nothing Then color_rng.Interior.ColorIndex = color_index: Set color_rng = Nothing
    For Each k In dict2.keys  '遍历dict2,判断所有键在dict1中是否存在
        If Not dict1.Exists(k) Then
            If color_rng Is Nothing Then
                Set color_rng = dict2(k)
            Else
                Set color_rng = Union(color_rng, dict2(k))
            End If
        End If
    Next
    If Not color_rng Is Nothing Then color_rng.Interior.ColorIndex = color_index: Set color_rng = Nothing
    Debug.Print "单元格区域数据对比标色,完成"
End Function

举例

vbnet 复制代码
Sub 测试()
    Dim rng1 As Range, rng2 As Range
    Set rng1 = Worksheets("表1").[a1].CurrentRegion
    Set rng2 = Worksheets("表2").[a1].CurrentRegion
    a = 单元格区域数据对比标色(rng1, rng2)
End Sub

对比差异并标记黄色

相关推荐
蜗牛沐雨1 小时前
Pandas 数据导出:如何将 DataFrame 追加到 Excel 的不同工作表
python·excel·pandas
JavaDog程序狗1 小时前
【java】easypoi导出excel单元格,填充动态下拉列
java·spring boot·excel
engchina6 小时前
Dify 使用 excel 或者 csv 文件创建知识库
excel·dify
过期的秋刀鱼!1 天前
数据分析之技术干货业务价值 powerquery 分组排序后取TOP
数据挖掘·数据分析·excel·数据清洗·分组排序·powerquery·电商货品分析
凯子坚持 c1 天前
Trae 宝藏功能实测:从 Mcp 搭建天气系统,到 AI 重塑 Excel 数据处理
java·人工智能·excel
二狗哈2 天前
制作一款打飞机游戏23:编辑器ui
ui·编辑器·excel
CodeCraft Studio2 天前
Excel处理控件Spire.XLS系列教程:Java设置Excel活动工作表或活动单元格
java·python·excel
CodeJourney.2 天前
深度探索:DeepSeek赋能WPS图表绘制
数据库·人工智能·算法·信息可视化·excel
努力的搬砖人.2 天前
在springboot项目中,如何进行excel表格的导入导出功能?
spring boot·后端·excel
java程序员CC2 天前
使用springboot+easyexcel实现导出excel并合并指定单元格
spring boot·后端·excel