检查指定列是否重复在另一列相应单元格进行标注

AFree123

检查指定列是否重复在另一列相应单元格进行标注
1、检查D列，如果D列单元格的前五个字符，如果存在重复，则在H列相应单元格内标注“重复”，有的重复可能存在3个以上（如D3、D8、D13），结果如同H列。
2、检查D列，如果D列单元格，如果存在重复，则在I列相应单元格内标注“与D8单元格重复”，D8为重复单元格位置，结果如同I列。主要是为了便于人工抽查。
3、本例仅是部分数据，实例有数千条数据。
可否使用VBA一键求得，请大师帮帮忙！谢谢！

xinyuan8751

字典可以的~
@_@

AFree123

xinyuan8751 发表于 2020-1-14 12:30
字典可以的~
@_@

是否有具体的，能否请老师帮帮忙，谢谢！

xinyuan8751

AFree123 发表于 2020-1-14 12:41
是否有具体的，能否请老师帮帮忙，谢谢！

正在尝试中ing~
@_@
不过我刚学，所以.............
哈~

AFree123

静待大神出现。。。

AFree123

呼唤我们可爱的大神尽快现身。。。期盼。。。

AFree123

热切期盼大神出现......

917067811

Sub ttt()
    Dim arr(), nrow&, rng As Range
   
    Dim dic As Object, dic2 As Object
   
    Set dic = CreateObject("Scripting.Dictionary")
    Set dic1 = CreateObject("Scripting.Dictionary")
   
    With Sheet1
        nrow = .Range("d1048576").End(xlUp).Row
        arr = .Range("d3:d" & nrow).Value
        '取重复性地址
        For Each rng In .Range("d3:d" & nrow)
            If dic(rng.Value) = "" Then
                dic(rng.Value) = rng.Address
               
            Else
                dic(rng.Value) = dic(rng.Value) + "," + rng.Address
            End If
        Next
        '前五个重复
        For Each rng In .Range("d3:d" & nrow)
            If dic1(Left(rng.Value, 5)) = "" Then
                dic1(Left(rng.Value, 5)) = rng.Address
            Else
                dic1(Left(rng.Value, 5)) = dic1(Left(rng.Value, 5)) + "," + rng.Address
            End If
        Next
        
        
        Dim addr1 As String, strtemp As String
        
        Dim brr
        '重复提示
        For Each rng In .Range("d3:d" & nrow)
            strtemp = ""
            If InStr(dic(rng.Value), ",") > 1 Then
                addr1 = rng.Address
                brr = Split(dic(rng.Value), ",")
                For Each i In brr
                    If i <> addr1 Then
                        strtemp = strtemp + Replace(i, "$", "") + ";"
                    End If
                    
                Next
                .Range(Replace(addr1, "D", "I")) = "与" + strtemp + "重复"
               

            End If
        Next
               
  
        
        
        
        
        Dim str1 As String
        
        '前5位重复
        For Each temp In dic1.keys()
            If InStr(dic1(temp), ",") > 1 Then
                str1 = Replace(dic1(temp), "D", "H")
                .Range(str1) = "重复"
            End If
            
        Next
        
        
    End With
   

   
   
   
   
End Sub

917067811

见附件。。。。。。

AFree123

917067811 发表于 2020-1-16 12:55
Sub ttt()
    Dim arr(), nrow&, rng As Range
   

感谢老师的帮助！真是太强大了！