[已解决]删除含有相同内容，保留其中一行

zss7758258

删除含有相同内容，保留其中一行.zip (287.12 KB, 下载次数: 13)

2015-4-18 20:43 上传

点击文件名下载附件

麻烦老师们了

最佳答案

月排行榜 / 总排行榜

dsmch

2015-4-18 20:57

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
6. For i = 1 To UBound(arr)
   
7.     If Not d.exists(arr(i, 7)) Then
   
8.         d(arr(i, 7)) = ""
   
9.         s = s + 1
   
10.         For j = 1 To UBound(arr, 2)
    
11.             brr(s, j) = arr(i, j)
    
12.         Next
    
13.     End If
    
14. Next
    
15. Sheet2.Range("a1").Resize(s, UBound(brr, 2)) = brr
    
16. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
6. For i = 1 To UBound(arr)
   
7.     If Not d.exists(arr(i, 7)) Then
   
8.         d(arr(i, 7)) = ""
   
9.         s = s + 1
   
10.         For j = 1 To UBound(arr, 2)
    
11.             brr(s, j) = arr(i, j)
    
12.         Next
    
13.     End If
    
14. Next
    
15. Sheet2.Range("a1").Resize(s, UBound(brr, 2)) = brr
    
16. End Sub

复制代码