sub fuzhifuzhi()
dim rng as range
a=inputbox("请输入需要查询字符")
set rng=nothing
if len(a)>0 then
for i=2 to sheets("Sheet1").[a65536].end(xlup).row
if sheets("Sheet1").cells(i,2) like "*" &a &"*" then
if rng is nothing then
set rng = sheets("Sheet1").rows(i)
else
set rng =union(rng, sheets("Sheet1").rows(i))
end if
end if
next
if not(rng is nothing) then
rng.copy sheets("Sheet2").[a2]
else
msgbox "未查询到符合条件数据"
end if
else
msgbox "输入内容不能为空" :exit sub
end if
end sub
追问谢谢,您给的代码实现成功了,上面输入框的条件需要改变一下,除了满足上面的条件外,还要满足,在输入框输入中华然后空格再输入法律(比如:中华 法律)就代表要找到含有中华和法律的数据,上面对应的数据应该是第3条,谢谢大神了
追答如下
Sub fuzhifuzhi()
Dim rng As Range
Sheets("Sheet2").Range("2:10000").ClearContents
a = InputBox("请输入需要查询字符")
Set rng = Nothing
If Len(a) > 0 Then
For i = 2 To Sheets("Sheet1").[b65536].End(xlUp).Row
b = Split(a, " ")
p = "OK"
For j = 0 To UBound(b)
If InStr(1, Sheets("Sheet1").Cells(i, 2).Value, b(j)) = 0 Then
p = "NG": Exit For
End If
Next
If p = "OK" Then
If rng Is Nothing Then
Set rng = Sheets("Sheet1").Rows(i)
Else
Set rng = Union(rng, Sheets("Sheet1").Rows(i))
End If
End If
Next
If Not (rng Is Nothing) Then
rng.Copy Sheets("Sheet2").[a2]
Else
MsgBox "未查询到符合条件数据"
End If
Else
MsgBox "输入内容不能为空": Exit Sub
End If
End Sub
追问您好,这个代码还有一个问题,就是第一次我查询的时候获得3条数据,那么sheet2中有三条数据,第二次查询获得2条数据,sheet2中还是3条数据,其中最后一条是第一次查询的数据,这一条不是需要的,最好是要把sheet2数据清空,再往里面复制数据,谢谢