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

对比差异并标记黄色

相关推荐
mudtools1 小时前
使用二次封装的Excel COM 组件操作Excel\WPS ET中的区域、行和列
excel
揭老师高效办公2 天前
在Excel和WPS表格中拼接同行列对称的不连续数据
excel·wps表格
用户0332126663672 天前
Java 设置 Excel 行高列宽:告别手动调整,拥抱自动化高效!
java·excel
专注VB编程开发20年2 天前
.NET组件读取压缩包中的内存数据电子表格XLSX文件和图片,不需要解压
linux·服务器·windows·c#·.net·excel·zip
菌王2 天前
EXCEL自动调整列宽适应A4 A3 A2
excel
专注VB编程开发20年3 天前
对excel xlsx文件格式当成压缩包ZIP添加新的目录和文件后,OpenXml、NPOI、EPPlus、Spire.Office组件还能读出来吗
数据库·c#·excel
用户0332126663673 天前
Java 将 CSV 转换为 Excel:告别繁琐,拥抱高效数据处理
java·excel
lijingguang3 天前
excel 破解工作表密码
excel
我命由我123453 天前
Excel 表格 - 合并单元格、清除单元格格式
运维·word·powerpoint·excel·工具·表格·软件工具
专注VB编程开发20年4 天前
OpenXml、NPOI、EPPlus、Spire.Office组件对EXCEL ole对象附件的支持
前端·.net·excel·spire.office·npoi·openxml·spire.excel