请求VBA代码需求:某一个单元格的值查询在其它一列数据中是否有重复如果有重复用颜色进行标记并在第一个重复值出现的单元格备注重复的数量。
以下是实现该需求的VBA代码:
Sub CheckDuplicates() Dim cell As Range Dim rngToCheck As Range Dim rngDuplicates As Range Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") '用于存储重复值
Set rngToCheck = Range("B:B") '要检查重复的数据范围
For Each cell In rngToCheck
If cell.Value <> "" Then
If dict.exists(cell.Value) Then '如果已经存在该值,则标记为重复
If rngDuplicates Is Nothing Then '如果是第一次找到重复,则记录范围
Set rngDuplicates = Range(cell.Address)
rngDuplicates.Interior.Color = vbRed
Else '如果不是第一次找到重复,则扩展范围
Set rngDuplicates = Union(rngDuplicates, Range(cell.Address))
cell.Interior.Color = vbRed
End If
dict(cell.Value) = dict(cell.Value) + 1 '记录该值的重复数量
Else '如果是新值,则加入字典
dict.Add cell.Value, 1
End If
End If
Next cell
If Not rngDuplicates Is Nothing Then '如果有重复值,则在第一个重复值出现的单元格备注重复的数量
With rngDuplicates.Cells(1)
.AddComment dict(.Value) & " duplicates found"
End With
End If
End Sub
将上述代码复制到VBA编辑器中的模块中,然后在工作表中的单元格中输入要检查重复的数据,运行该宏即可。如果有重复的数据,则会用红色标记,并在第一个重复值出现的单元格上备注重复的数量。
原文地址: https://www.cveoy.top/t/topic/gLN 著作权归作者所有。请勿转载和采集!