[已解决]两表过滤重复

新会甜橙

数据工作表e列和总表e列核对,重复的复制到重复表

最佳答案

月排行榜 / 总排行榜

lisachen

2013-3-28 21:59

9楼至总表的整行
本楼是数据表的整行

1. Sub test()
   
2.     Dim d
   
3.     Dim x%, y%
   
4. 
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Sheets("数据")
   
7.         For x = 3 To .[e65536].End(3).Row
   
8.             d(.Cells(x, 5).Value) = x
   
9.         Next x
   
10.     End With
    
11.     k = 1
    
12.     With Sheets("总表")
    
13.         For x = 2 To .Range("e65536").End(3).Row
    
14.             If d.Exists(.Cells(x, 5).Value) Then
    
15.                 k = k + 1
    
16.                For y = 1 To 23
    
17.                Sheets("重复").Cells(k, y) = Sheets("数据").Cells(x, y)
    
18.                Next y
    
19.             End If
    
20.         Next x
    
21.     End With
    
22. End Sub

复制代码

跳转到最佳答案楼层

无聊的疯子

只复制重复的E列数据??

hwc2ycy

无聊的疯子 发表于 2013-3-28 21:07
只复制重复的E列数据??

你又在挤？

无聊的疯子

hwc2ycy 发表于 2013-3-28 21:16
你又在挤？

人家发贴老半天了,你也不回下,赶紧做题给他解决了!!

lisachen

1. Sub test()
   
2.     Dim d
   
3.     Dim x%, y%
   
4. 
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Sheets("数据")
   
7.         For x = 3 To .[e65536].End(3).Row
   
8.             d(.Cells(x, 5).Value) = ""
   
9.         Next x
   
10.     End With
    
11.     y = 1
    
12.     With Sheets("总表")
    
13.         For x = 2 To .Range("e65536").End(3).Row
    
14.             If d.Exists(.Cells(x, 5).Value) Then
    
15.                 y = y + 1
    
16.                 Sheets("重复").Cells(y, 1) = .Cells(x, 5)
    
17.             End If
    
18.         Next x
    
19.     End With  
    
20. End Sub

复制代码

hwc2ycy

无聊的疯子 发表于 2013-3-28 21:16
人家发贴老半天了,你也不回下,赶紧做题给他解决了!!

还是你来。今天不在状态，白天太累了，复杂的想不动了。

新会甜橙

无聊的疯子 发表于 2013-3-28 21:07
只复制重复的E列数据??

只复制重复E列整行数据

新会甜橙

lisachen 发表于 2013-3-28 21:20

复制E列重复的整行数据

lisachen

新会甜橙 发表于 2013-3-28 21:52
复制E列重复的整行数据

1. Sub test()
   
2.     Dim d
   
3.     Dim x%, y%
   
4. 
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Sheets("数据")
   
7.         For x = 3 To .[e65536].End(3).Row
   
8.             d(.Cells(x, 5).Value) = x
   
9.         Next x
   
10.     End With
    
11.     k = 1
    
12.     With Sheets("总表")
    
13.         For x = 2 To .Range("e65536").End(3).Row
    
14.             If d.Exists(.Cells(x, 5).Value) Then
    
15.                 k = k + 1
    
16.                For y = 1 To 23
    
17.                Sheets("重复").Cells(k, y) = .Cells(x, y)
    
18.                Next y
    
19.             End If
    
20.         Next x
    
21.     End With
    
22. End Sub

复制代码

lisachen

9楼至总表的整行
本楼是数据表的整行

1. Sub test()
   
2.     Dim d
   
3.     Dim x%, y%
   
4. 
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Sheets("数据")
   
7.         For x = 3 To .[e65536].End(3).Row
   
8.             d(.Cells(x, 5).Value) = x
   
9.         Next x
   
10.     End With
    
11.     k = 1
    
12.     With Sheets("总表")
    
13.         For x = 2 To .Range("e65536").End(3).Row
    
14.             If d.Exists(.Cells(x, 5).Value) Then
    
15.                 k = k + 1
    
16.                For y = 1 To 23
    
17.                Sheets("重复").Cells(k, y) = Sheets("数据").Cells(x, y)
    
18.                Next y
    
19.             End If
    
20.         Next x
    
21.     End With
    
22. End Sub

复制代码