|
发表于 2015-1-14 16:40
|
显示全部楼层
本楼为最佳答案
如果要体现筛选效果(输出结果按Sheet2里的A列排序),可以这样:- Sub tt()
- Dim CopyRng As Range
- Set d = CreateObject("scripting.dictionary")
- With Sheets("TEST")
- brr = .[a1].CurrentRegion
- Set CopyRng = .[a1].Resize(1, 21)
- For i = 2 To UBound(brr)
- If Not d.exists(brr(i, 20)) Then
- Set d(brr(i, 20)) = .Cells(i, 1).Resize(1, 21)
- Else
- Set d(brr(i, 20)) = Union(d(brr(i, 20)), .Cells(i, 1).Resize(1, 21))
- End If
- Next
- End With
-
- arr = Sheets("Sheet2").[a1].CurrentRegion
- For i = 1 To UBound(arr)
- Set CopyRng = Union(CopyRng, d(arr(i, 1)))
- Next
- With Sheets("Sheet3")
- .Cells.Clear
- CopyRng.Copy .[a1]
- .Activate
- End With
- End Sub
复制代码 |
评分
-
查看全部评分
|