|
Sub HighlightAndCountDuplicates()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("test") ' 请根据实际情况修改工作表名称
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.count, "B").End(3).Row ' 获取B列的最后一行
Dim i As Long
Dim value As String
Dim count As Long
Dim chazhaoquyud As Range
Set chazhaoquyu = ws.Range("F3:N" & lastRow)
Application.ScreenUpdating = False ' 关闭屏幕更新以加快宏的运行速度
' 遍历B列的数据
For i = 3 To lastRow
value = ws.Cells(i, "B").value ' 获取B列的值
count = 0
For Each cz In chazhaoquyu
If cz = value Then
count = count + 1 ' 增加重复次数
cz.Interior.Color = RGB(255, 255, 0) ' 标注底色为黄色
End If
Next
' ' 在C列统计重复的次数
ws.Cells(i, "C").value = count
Next i
Application.ScreenUpdating = True ' 重新打开屏幕更新
End Sub |
|