[已解决]提取符合条件的数据

梦想有多远

求大神帮忙看看代码出错在哪里？目前只能提取一列，我要将数据源每一列符合条件的数据提取出来

最佳答案

月排行榜 / 总排行榜

望帝春心

2016-12-16 13:53

1. Sub test()
   
2.     Dim arr, i&, j&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("数据源").[a1].CurrentRegion.Offset(1, 0).value
   
5.     For i = 1 To UBound(arr)
   
6.         For j = 1 To UBound(arr, 1)
   
7.             If arr(i, j) = Sheets("高级查询").[b1].value Then
   
8.                 d(i) = ""
   
9.             End If
   
10.         Next
    
11.     Next
    
12.     Application.ScreenUpdating = False
    
13.     For Each Key In d.keys
    
14.         Sheets("数据源").[a1].CurrentRegion.Rows(Key + 1).Copy Sheets("高级查询").[a1].End(4).Offset(1, 0)
    
15.     Next
    
16.     Sheets("高级查询").[a1].CurrentRegion.Borders.LineStyle = 1
    
17.     Application.ScreenUpdating = True
    
18. End Sub

复制代码

跳转到最佳答案楼层

zjdh

代码呢？附件呢？

望帝春心

别闹，认真点！！！！

梦想有多远

不好意思，忘记上传了

梦想有多远

zjdh 发表于 2016-12-16 12:36
代码呢？附件呢？

老师，刚才忘记上传了，麻烦你帮忙看看，谢谢

望帝春心

1. Sub test()
   
2.     Dim arr, i&, j&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("数据源").[a1].CurrentRegion.Offset(1, 0).value
   
5.     For i = 1 To UBound(arr)
   
6.         For j = 1 To UBound(arr, 1)
   
7.             If arr(i, j) = Sheets("高级查询").[b1].value Then
   
8.                 d(i) = ""
   
9.             End If
   
10.         Next
    
11.     Next
    
12.     Application.ScreenUpdating = False
    
13.     For Each Key In d.keys
    
14.         Sheets("数据源").[a1].CurrentRegion.Rows(Key + 1).Copy Sheets("高级查询").[a1].End(4).Offset(1, 0)
    
15.     Next
    
16.     Sheets("高级查询").[a1].CurrentRegion.Borders.LineStyle = 1
    
17.     Application.ScreenUpdating = True
    
18. End Sub

复制代码

梦想有多远

望帝春心 发表于 2016-12-16 13:53

谢谢老师的解答，万分感谢。祝老师身体健康，万事如意。