应用场景

把选择区域的重复值标识出不同颜色

知识要点

1：Selection.Areas.Count 选择区域的个数

2：Application.Calculation = xlCalculationManual   调整成手动计算

3：IIf 函数 根据表达式的值，来返回两部分中的其中一个  避免大于10位的数值在计算后显示为科学计数法，对大于10位的值添加'’'，对每个值添加后缀'-'

4：Rng.Interior.ColorIndex 属性  返回或设置一个 Variant 值，它代表内部颜色

Sub 标识重复值()  '可对前54个重复值的数据着色

    If TypeName(Selection) <> 'Range' Then Exit Sub  '如果选择对象不是单元格则退出

    If Selection.Count < 3 Then MsgBox '请选取一个较大的非空区域在执行', 64, '提示': Exit Sub  '选区太小则退出

    If Selection.Areas.Count > 1 Then MsgBox '仅对一个区域生效': Exit Sub  '如果选择多个区域则退出

    If Selection.Rows.Count = Rows.Count Or Selection.Columns.Count = Columns.Count Then MsgBox '请不要选择整行整列': Exit Sub '如果选择整行整列则退出

    Application.ScreenUpdating = False  '关闭屏幕刷新

    Application.Calculation = xlCalculationManual '手动计算

    Dim Rng As Range, i As Long, Rngg As Range, Cell As Range

    i = 0

    On Error Resume Next '有错继续执行

    Set Rngg = Intersect(ActiveSheet.UsedRange, Selection) '将选区与已用区域的交集赋值给变量

    Rngg.Interior.ColorIndex = xlNone  '清除原有背景颜色

    '通过循环在原字符后面加一个“-”，如果大于10位，在前面添加一个'，用途是避免10位以上的数字包括身份证号在计算重复时出错，同时也避免最后删除“-”后

    '以科学计数形式显示，从而保护数据不被破坏

    For Each Cell In Rngg   '遍历所有单元格

        If Len(Cell) > 0 Then Cell.Value = IIf(Len(Cell.Text) > 10, ''', '') & Cell.Text & '-'

    Next

    For Each Rng In Rngg  '在次遍历单元格

        If Len(Rng) = 0 Then GoTo Nexta '如果单元格空白则进入下一组循环

        If WorksheetFunction.CountIf(Rngg, Rng.Text) > 1 Then          '如果单元格rng在整个区域中不止一个，

            If WorksheetFunction.CountIf([XFD1:XFD1000], Rng.Text) = 0 Then  'XFD1:XFD1000做辅助区，存放重复值

                i = i 1  '累加变量，该变量等于重复值的个数

                Cells(i, 16384) = Rng.Text  '第16384列存放重复值

            End If

            Rng.Interior.ColorIndex = 2 WorksheetFunction.Match(Rng, [XFD1:XFD1000], 0) '对rng单元格设置背景色，颜色值为rng的值在IV列辅助区中的排位 2，加2是为了排除白色和黑色

        End If

        If i > 54 Then Exit For  '如果i 等于 54 时，则退出循环，（excel 支持56种颜色，除黑白外只有54色）

Nexta:

    Next Rng

    Rngg.Replace '-', '', xlPart '替换后缀前缀

    [XFD1:XFD1000].Clear '清除辅助列

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic  '自动计算

End Sub

------------------------------------