[已解决]vba跨表删除重复行记录

zero-zoey

问题见附件，谢谢！ 跨表删除重复行记录.rar (16.78 KB, 下载次数: 24)

2013-2-26 17:42 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-2-26 18:26

1. Sub 去重复行()
   
2.     Dim iLastRow&
   
3.     Dim i&, j&
   
4.     Dim arrTemp, arr
   
5.     Dim str$
   
6. 
   
7.     Dim dic As Object
   
8.     Dim keys, items
   
9.     Set dic = CreateObject("scripting.dictionary")
   
10. 
    
11.     With Worksheets("Sheet2")
    
12.         arr = .Range("a1").CurrentRegion
    
13.         For i = 2 To UBound(arr)
    
14.             arrTemp = WorksheetFunction.Index(arr, i, 0)
    
15.             'Stop
    
16.             dic(Join(arrTemp, "#")) = ""
    
17.         Next
    
18.     End With
    
19.    
    
20.     arr = Range("a12").CurrentRegion.Value
    
21.     Application.ScreenUpdating = False
    
22.    
    
23.     For i = UBound(arr) To 2 Step -1
    
24.         arrTemp = WorksheetFunction.Index(arr, i, 0)
    
25.         str = Join(arrTemp, "#")
    
26.         If dic.Exists(str) Then
    
27.             Rows(11 + i).Delete
    
28.             j = j + 1
    
29.         End If
    
30.     Next
    
31.     Application.ScreenUpdating = True
    
32.     If j > 0 Then MsgBox "一共删除了 " & j & " 条重复行"
    
33. End Sub

复制代码

跳转到最佳答案楼层

zjdh

你的数据是随机函数产生，只要删除或修改一个单元，所有数据都会改变！
所以，无法解决啦！！

hwc2ycy

你的单元格不该用随机函数，会自动刷新的。

hwc2ycy

1. Sub 去重复行()
   
2.     Dim iLastRow&
   
3.     Dim i&, j&
   
4.     Dim arrTemp, arr
   
5.     Dim str$
   
6. 
   
7.     Dim dic As Object
   
8.     Dim keys, items
   
9.     Set dic = CreateObject("scripting.dictionary")
   
10. 
    
11.     With Worksheets("Sheet2")
    
12.         arr = .Range("a1").CurrentRegion
    
13.         For i = 2 To UBound(arr)
    
14.             arrTemp = WorksheetFunction.Index(arr, i, 0)
    
15.             'Stop
    
16.             dic(Join(arrTemp, "#")) = ""
    
17.         Next
    
18.     End With
    
19.    
    
20.     arr = Range("a12").CurrentRegion.Value
    
21.     Application.ScreenUpdating = False
    
22.    
    
23.     For i = UBound(arr) To 2 Step -1
    
24.         arrTemp = WorksheetFunction.Index(arr, i, 0)
    
25.         str = Join(arrTemp, "#")
    
26.         If dic.Exists(str) Then
    
27.             Rows(11 + i).Delete
    
28.             j = j + 1
    
29.         End If
    
30.     Next
    
31.     Application.ScreenUpdating = True
    
32.     If j > 0 Then MsgBox "一共删除了 " & j & " 条重复行"
    
33. End Sub

复制代码

zero-zoey

hwc2ycy 发表于 2013-2-26 18:26

谢谢，完美解决问题。羡慕呀，什么时候自己也能写出这般代码，先慢慢消化。。。（偷懒用随机数字生成的试验数据）