Excel·VBA单元格重复值标记颜色

《excelhome提问-标记重复值的问题》,对同一行的多列内容都重复的标记颜色

仅需选中要标记颜色的多列,即可运行代码;且不同的重复值标记不同颜色
注意:由于使用了Union函数,故不支持单列;区分字母大小写

Sub 选中列重复标记颜色()
    '适用多列选中、多列部分选中,选中区域内整行重复的标记颜色(合并单元格不影响)
    Dim rng As Range, dict As Object, first_row, last_row, first_col, last_col, i, j, res, rang_count, temp, v, c
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    If rng.Columns.count = 1 Then Debug.Print "不支持单列": Exit Sub  '不支持单列,退出
    first_row = rng.Row     '选中区域开始行号
    last_row = first_row + rng.Rows.count - 1  '选中区域结束行号
    first_col = rng.Column  '选中区域开始列号
    last_col = first_col + rng.Columns.count - 1  '选中区域结束列号
    rang_count = rng.Columns.count  '每行单元格数
    Set dict = CreateObject("scripting.dictionary")
    
    For i = first_row To last_row
        res = ""
        For j = first_col To last_col
            res = res & CStr(Cells(i, j).Value)
        Next
        Set temp = Range(Cells(i, first_col), Cells(i, last_col))  '选中区域每行为一个range
        If Not dict.Exists(res) And res <> "" Then  '新键,且不为空值
            Set dict(res) = temp
        ElseIf res <> "" Then
            Set dict(res) = Union(dict(res), temp)
        End If
    Next
    v = dict.Items
    c = 2  '开始颜色index,1为黑2为白
    For i = 0 To dict.count - 1
        If v(i).count > rang_count Then
            c = c + 1
            v(i).Interior.ColorIndex = c
            If c >= 56 Then c = 2  '颜色循环
        End If
    Next
    
End Sub

举例

选中A-D列,运行代码,获得结果
在这里插入图片描述

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

薛定谔_51

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值