[已解决]对应的行列信息复制在sheet2

simao432

各位老师，实现这个功能，如何编写程序，感谢
如第一张表中很多数据，我只想查找某一数据（如上海），如果找到，将它对应的行列信息复制在sheet2中

希望学习到源代码，谢谢各位

最佳答案

月排行榜 / 总排行榜

26759761@qq.com

2015-3-26 16:46

1. Sub x()
   
2. Dim st, x, arr, brr(1 To 50000, 1 To 4), c, r
   
3. st = (InputBox("请输入要查找的城市"))
   
4.   arr = Range("a1").CurrentRegion
   
5.    For x = 1 To UBound(arr)
   
6.      If arr(x, 1) = st Then
   
7.        r = r + 1
   
8.        For c = 1 To 4
   
9.          brr(r, c) = arr(x, c)
   
10.        Next
    
11.      End If
    
12.    Next
    
13.   If r > 0 Then
    
14.       Sheet2.Select: Cells.Clear
    
15.       [a1].Resize(r, 4) = brr
    
16.       MsgBox "处理完毕"
    
17.      Else
    
18.       MsgBox "没找到数据"
    
19.    End If
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

爱疯

http://www.excelpx.com/thread-297695-1-1.html

由于不是按这题需求写的，所以拆分后需手动删除不要的工作表

26759761@qq.com

1. Sub x()
   
2. Dim st, x, arr, brr(1 To 50000, 1 To 4), c, r
   
3. st = (InputBox("请输入要查找的城市"))
   
4.   arr = Range("a1").CurrentRegion
   
5.    For x = 1 To UBound(arr)
   
6.      If arr(x, 1) = st Then
   
7.        r = r + 1
   
8.        For c = 1 To 4
   
9.          brr(r, c) = arr(x, c)
   
10.        Next
    
11.      End If
    
12.    Next
    
13.   If r > 0 Then
    
14.       Sheet2.Select: Cells.Clear
    
15.       [a1].Resize(r, 4) = brr
    
16.       MsgBox "处理完毕"
    
17.      Else
    
18.       MsgBox "没找到数据"
    
19.    End If
    
20. End Sub
    

复制代码

1091126096

是模糊查找还是完全匹配？

simao432

1091126096 发表于 2015-3-26 16:48
是模糊查找还是完全匹配？

完全匹配
感谢

1091126096

完全匹配就不需用VBA，最简单方法是：筛选-复制-粘贴

zhangbao1985031

如果说表一中有合并单元格，怎么办