求助：利用VBA删除重复的单元格

qq25536956

附件中sheet1中有重复的单元格，如何能利用VBA自动删除。希望的到的结果在sheet2中。请高手帮忙指点。
test.zip (4.72 KB, 下载次数: 11)

2013-4-1 21:05 上传

点击文件名下载附件

dsmch

1. Dim d As Object, i&, s&
   
2. Sheet1.Activate
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 1 To Range("a65536").End(xlUp).Row
   
5.     If Cells(i, 1) Like "test*" Then
   
6.         If Not d.exists(Cells(i, 1).Value) Then d.Add Cells(i, 1).Value, i
   
7.     End If
   
8. Next
   
9. b = d.items: s = 1
   
10. For i = 0 To d.Count - 1
    
11.     Cells(b(i), 1).CurrentRegion.Copy Sheet2.Cells(s, 1)
    
12.     s = Sheet2.Range("a65536").End(xlUp).Row + 2
    
13. Next
    
14. Sheet2.Activate
    

复制代码

dsmch

………………

grf1973

不用判断d.exists也行。小改如下：
Sub test()
    Dim d As Object, i&, s&
    Sheet1.Activate
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To Range("a65536").End(xlUp).Row
        If Cells(i, 1) Like "test*" Then d(Cells(i, 1).Value) = i
    Next
    b = d.items: s = 1
    For i = 0 To d.Count - 1
        Cells(b(i), 1).CurrentRegion.Copy Sheet2.Cells(s, 1)
        s = Sheet2.Range("a65536").End(xlUp).Row + 2
    Next
    Sheet2.Activate
End Sub