![图片[1]-Excel多重复值标注不同颜色-春枫博客](https://www.cfbk.top/wp-content/uploads/2023/09/image-1.png)
在工作中我们使用Excel难免要遇到一些多种重复值不同颜色筛选这个问题一直很苦恼我们可以使用Excel的VBA宏来完成这个任务废话不多说请看代码
![图片[2]-Excel多重复值标注不同颜色-春枫博客](https://www.cfbk.top/wp-content/uploads/2023/09/image-2.png)
Sub ColorDuplicatesWithIgnore()
Dim rng As Range
Dim cell As Range
Dim dict As Object
Dim colorIndex As Long
Dim color As Long
Dim ignoreList() As String
Dim ignoreText As String
' 选择要标注重复值的数据范围
On Error Resume Next
Set rng = Application.InputBox("请选择要标注重复值的数据范围:", Type:=8)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
' 创建字典对象
Set dict = CreateObject("Scripting.Dictionary")
' 自定义忽略文本列表
ignoreText = InputBox("请输入要忽略的文本(使用逗号分隔):") ' 输入要忽略的文本,多个文本可以使用逗号分隔
ignoreList = Split(ignoreText, ",") ' 将输入的文本拆分为数组
' 遍历每个单元格
For Each cell In rng
If Not IsEmpty(cell.Value) Then
' 检查单元格值是否在忽略列表中
If Not IsInArray(cell.Value, ignoreList) Then ' 如果单元格的值不在忽略列表中,才进行颜色标注
' 如果单元格的值已存在于字典中,则使用已分配的颜色
If dict.exists(cell.Value) Then
color = dict(cell.Value)
Else
' 如果单元格的值不存在于字典中,则分配一个新的颜色
colorIndex = colorIndex + 1
color = RGB(Rnd * 255, Rnd * 255, Rnd * 255) ' 随机分配颜色
dict.Add cell.Value, color
End If
' 应用颜色到单元格
cell.Interior.Color = color
End If
End If
Next cell
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
' 检查字符串是否在数组中
Dim element As Variant
For Each element In arr
If Trim(element) = Trim(stringToBeFound) Then
IsInArray = True
Exit Function
End If
Next element
IsInArray = False
End Function
视频如下:
© 版权声明
本文为原创作品,版权归春枫博客所有。未经允许,禁止一切形式的盗用,违者将依法追究。谢谢您的合作!
THE END
暂无评论内容