[已解决]查找并提取重复

KDZ

         各位大师：
      请帮忙做个VBA,实现查找A、C列相同的名字【几万个名字】，并将相同的名字放在E列，谢谢！

最佳答案

月排行榜 / 总排行榜

windyjw007

2017-5-30 13:48

试试！{:1612:}

1. Sub test()
   
2.     Dim d As Object
   
3.     Dim ar, br
   
4.     Dim i As Long
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     ar = Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
   
7.     br = Range("C3:C" & Cells(Rows.Count, 1).End(3).Row)
   
8.     For i = 1 To UBound(br)
   
9.         If Not d.exists(br(i, 1)) Then d.Add br(i, 1), ""
   
10.     Next i
    
11.     For i = 1 To UBound(ar)
    
12.         If d.exists(ar(i, 1)) Then
    
13.             j = j + 1
    
14.             ar(j, 1) = ar(i, 1)
    
15.         End If
    
16.     Next i
    
17.     With Cells(3, 5)
    
18.         .Resize(Rows.Count - 2).ClearContents
    
19.         If j > 0 Then .Resize(j) = ar
    
20.     End With
    
21. End Sub

复制代码

跳转到最佳答案楼层

windyjw007

试试！{:1612:}

1. Sub test()
   
2.     Dim d As Object
   
3.     Dim ar, br
   
4.     Dim i As Long
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     ar = Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
   
7.     br = Range("C3:C" & Cells(Rows.Count, 1).End(3).Row)
   
8.     For i = 1 To UBound(br)
   
9.         If Not d.exists(br(i, 1)) Then d.Add br(i, 1), ""
   
10.     Next i
    
11.     For i = 1 To UBound(ar)
    
12.         If d.exists(ar(i, 1)) Then
    
13.             j = j + 1
    
14.             ar(j, 1) = ar(i, 1)
    
15.         End If
    
16.     Next i
    
17.     With Cells(3, 5)
    
18.         .Resize(Rows.Count - 2).ClearContents
    
19.         If j > 0 Then .Resize(j) = ar
    
20.     End With
    
21. End Sub

复制代码

jp1989226

用countif函数就可以实现了