遍历整表查重

newlove

单列隔行数据查重，出现相同数据 ，提示，遍历。

清风竹-

请看附件。

ykcbf1100

重复是标色处理还是提示？标色的话，前几天刚有过类似的帖子。

ykcbf1100

重复标色提示

ykcbf1100

代码供参考。。。

1. Sub ykcbf()  '//2024.2.28
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         .UsedRange.Interior.ColorIndex = 0
   
5.         r = .Cells(Rows.Count, 2).End(3).Row
   
6.         c = .UsedRange.Columns.Count
   
7.         arr = .[a1].Resize(r, c)
   
8.         b = [{5,9,11}]
   
9.         On Error Resume Next
   
10.         For j = 2 To c
    
11.             n = 4
    
12.             If arr(4, j) <> Empty Then
    
13.                 For i = 5 To r Step 2
    
14.                     s = arr(i + 1, j)
    
15.                     d(s) = d(s) + 1
    
16.                 Next
    
17.                 For Each k In d.keys
    
18.                     If d(k) > 1 Then
    
19.                         n = n + 1
    
20.                         For x = 1 To UBound(b)
    
21.                             If n = b(x) Then n = n + 1
    
22.                         Next
    
23.                         d(k) = n
    
24.                     End If
    
25.                 Next
    
26.                 For i = 5 To r Step 2
    
27.                     s = arr(i + 1, j)
    
28.                     If s <> Empty Then
    
29.                         If d(s) > 1 Then
    
30.                             .Cells(i + 1, j).Interior.ColorIndex = d(s)
    
31.                         End If
    
32.                     End If
    
33.                 Next
    
34.             End If
    
35.             d.RemoveAll
    
36.         Next
    
37.     End With
    
38.     Set d = Nothing
    
39.     MsgBox "OK！"
    
40. End Sub
    
41. 
    

复制代码

newlove

ykcbf1100 发表于 2024-2-28 08:59
重复是标色处理还是提示？标色的话，前几天刚有过类似的帖子。

是的，看到那个贴子。具体要求：单列出现相同，着色就可以，相邻 列 着同色，隔 列不同色。

ykcbf1100

newlove 发表于 2024-2-28 09:25
是的，看到那个贴子。具体要求：单列出现相同，着色就可以，相邻 列 着同色，隔 列不同色。

隔列没必要，现在的代码是同列多人重复时不同色，这就行了。

newlove

ykcbf1100 发表于 2024-2-28 09:22
重复标色提示

是这个，就是把颜色再进行区分一下就炽，单列出现多个不同数据相同，用不同色彩加以区分，更明显了。

newlove

ykcbf1100 发表于 2024-2-28 09:30
隔列没必要，现在的代码是同列多人重复时不同色，这就行了。

嗯嗯 ，对，同列就行了。

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, cr, i&, j&, k&, n&, dic As Object, vKey
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    With Range("B4", Cells(Rows.Count, "BC").End(xlUp))
        ar = .Value
        .Interior.Color = xlNone
        n = 2
        For j = 1 To UBound(ar, 2)
            dic.RemoveAll
            For i = 3 To UBound(ar) Step 2
                If Len(ar(i, j)) Then
                    dic(ar(i, j)) = dic(ar(i, j)) & " " & i
                End If
            Next i
            For Each vKey In dic.keys
                cr = Split(dic(vKey))
                If UBound(cr) > 1 Then
                    n = n + 1
                    If n = 57 Then n = 3
                    For k = 1 To UBound(cr)
                        .Cells(cr(k), j).Interior.ColorIndex = n
                    Next k
                End If
            Next
        Next j
    End With
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub