打开APP
userphoto
未登录

开通VIP,畅享免费电子书等14项超值服

开通VIP
Excel-VBA标识重复值

应用场景

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


知识要点

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

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


本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报
打开APP,阅读全文并永久保存 查看更多类似文章
猜你喜欢
类似文章
【热】打开小程序,算一算2024你的财运
Excel VBA] 认识VBA过程及开发自定义函数
完全手册Excel VBA典型实例大全:通过368个例子掌握
Excel 请问怎么限定单元格输入的数据类型
自学资料(Excel VBA)[收集整理3]
用VBA代码查询两列数据差异
Excel中快速大量输入时间法
更多类似文章 >>
生活服务
热点新闻
分享 收藏 导长图 关注 下载文章
绑定账号成功
后续可登录账号畅享VIP特权!
如果VIP功能使用有故障,
可点击这里联系客服!

联系客服