查找并返回所有行

tom1278

	100436	春	2341234	341234	32412	1234
	100729	134	34234	123	223	234
	100912	432	324	春	2	22341
	101127	1234	2341	341	1234	1341
	101340	1234	134	3124	123	1234123
	101529		春	1234	123421	12341
	101724	劳而无功	反对党	士大夫	夺	妈

我想查找所有“春”，并返回含“春”的行

	100436	春	2341234	341234	32412	1234
	100912	432	324	春	2	22341
	101529		春	1234	123421	12341

我写的代码不对，麻烦大神指点下
Sub 计()
    Dim myrange As Range, i As Integer
    For i = 2 To [b65535].End(xlUp).Row
      Set myrange = Range(Cells(i, 1), Cells(i, 16)).Find(what:="春", LookIn:=xlValues)
      k = 1
      If myrange Is Nothing Then
        i = i + 1
        Else: Cells(i, 1).EntireRow.Copy Sheets(Sheets.Count).Range("a" & k)
        k = k + 1
      End If
     Next i
End Sub

alstar

Sub fd()
For Each rng In Range("B2:G8")
If rng = "春" Then
n = n + 1
Cells(n, 1) = rng.Row
End If
Next
End Sub

tom1278

感谢，我特别喜欢短代码，而且也成功了，不过我想整行挑出来，我把
cells(n,1)=rng.row
改成
sheets(sheets.count).cells(n,1)=rng.entirerow
后，就成败了
还有，我是菜鸡，如果不太麻烦的话，请指点一下，我用过
for each——不成功
for——不成功
findnext——不成功
vlookup——后来知道不可能
怎么看起来挺好的代码，只要稍微改一个小地方就会失败

tudarong

tom1278 发表于 2018-7-23 07:43
感谢，我特别喜欢短代码，而且也成功了，不过我想整行挑出来，我把
cells(n,1)=rng.row
改成

sheets(sheets.count).cells(n,1)=rng.entirerow
你这句代码有问题。
sheets.count是工作簿中工作表的总数（这里工作表数是3），
简化即sheets(3).cells(n,1)=rng.entirerow，你的数据在sheets(1)

你想把整行挑出来，是想达到什么效果呢？
没看明白你的要求。

tudarong

在楼上的代码追加了一句，
把有“春”字那行颜色填充。

1. Sub fd()
   
2. Dim Rng As Range, n As Integer
   
3.     For Each Rng In Range("B2").CurrentRegion
   
4.         If Rng = "春" Then
   
5.             n = n + 1
   
6.             Rng.EntireRow.Interior.Color = 49407
   
7.         End If
   
8.     Next
   
9. End Sub

复制代码

查找返回.7z (16.02 KB, 下载次数: 18)

2018-7-23 08:12 上传

点击文件名下载附件

jiangxiaoyun

Sub 计()
    Dim myrange As Range, i As Integer
    k = 1
    For i = 2 To [b65535].End(xlUp).Row
        Set myrange = Range(Cells(i, 2), Cells(i, 7)).Find(what:="春", LookIn:=xlValues)
        If Not myrange Is Nothing Then
            Cells(i, 1).EntireRow.Copy Sheets(Sheets.Count).Range("a" & k)
            k = k + 1
        End If
    Next i
End Sub

tom1278

感谢各位的帮助，6楼的答案完美解决了我的问题，供各位参考，2楼的答案只在我上传的这个表中成功了，换成我的真实工作环境就没反应。
Sub fd2()
For Each Rng In Range("d2:p200")
If Rng = "春" Then
n = n + 1
Rng.EntireRow.Copy Sheets(Sheets.Count).Cells(n, 1)
End If
Next
End Sub
我的真实工作环境与上传表的差别在于，“春天，仲春”，只要是含“春”的行都整行挑出来，但我试过
rng="*春*”或者rng.text="*春*"
都没反应，vba真的是好难捉摸
也感谢4楼，给我启发，因为有一列是文件名，我把他们单独挑出来要进行文件拷贝