[已解决]求助如何筛选符合条件的相关数据并复制

wingotoo

x1中有上面数据


要实现效果是，X2中要从X1找出所有12的然后复制过来，按照上图所示，请问如何写程序呢？

123.rar (7.45 KB, 下载次数: 5)

2015-5-3 09:49 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

qh8600

2015-5-3 10:17

123.rar (17.69 KB, 下载次数: 10)

2015-5-3 10:21 上传

点击文件名下载附件

楼主试试

跳转到最佳答案楼层

baksy

函数解决

qh8600

1. Sub demo()
   
2.     Dim ar, br, i, n, x
   
3.     If Sheets("x1").AutoFilterMode = False Then MsgBox "没有筛选": Exit Sub
   
4.     x = Sheets("x1").AutoFilter.Filters(1).Criteria1
   
5.     x = Val(Right(x, Len(x) - 1))
   
6.     ar = Sheets("x1").Range("a1:b" & Sheets("x1").Cells(Rows.Count, 1).End(3).Row)
   
7.     ReDim br(1 To UBound(ar) + 1, 1 To 2)
   
8.     For i = 1 To UBound(ar)
   
9.         If ar(i, 1) = x Or ar(i, 1) = "选择" Then
   
10.             n = n + 1
    
11.             br(n, 1) = ar(i, 2)
    
12.             br(n, 2) = ar(i, 1)
    
13.         End If
    
14.     Next
    
15.     Columns("a:b").ClearContents
    
16.     Range("a1").Resize(n, 2) = br
    
17. End Sub

复制代码

附件楼下

qh8600

123.rar (17.69 KB, 下载次数: 10)

2015-5-3 10:21 上传

点击文件名下载附件

楼主试试