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列,运行代码,获得结果
Excel·VBA单元格重复值标记颜色_第1张图片

你可能感兴趣的:(excel,excel,vba)