数据查找和统计

Qs18

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

gwjkkkkk

amd001 发表于 2024-4-19 10:01
有没有办法，一次性把结果显示标注出来，这个必须要选中才行，不符合实际需求~~

请参考。。。

amd001

gwjkkkkk 发表于 2024-4-19 17:47
请参考。。。

谢谢~~~能用，我跑跑大量的试下

amd001

Qs18 发表于 2024-4-19 14:11
Sub HighlightAndCountDuplicates()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("test") ...

感谢~~·我试试看~~~