我现在有这样一个需求，在excel中，通过在宏中编辑vba代码，把sheet1中满足条件的数据复制到sheet2中，

sheet1中的数据为两列，a列是1到6的数字，b列是字符串，当点击宏的执行按钮时，弹出文字输入框，通过输入框里的文字去匹配sheet1中的字符串，把和输入框里相同的sh... sheet1中的数据为两列，a列是1到6的数字，b列是字符串，当点击宏的执行按钮时，弹出文字输入框，通过输入框里的文字去匹配sheet1中的字符串，把和输入框里相同的sheet1中的数据找出复制到sheet2中（比如说输入中国，从sheet1的数据中去找哪些字符串中含有中国这两个字的数据），非常期望能获得各位大神的帮助，谢谢（sheet1如下，a列NUM,
b列STRING）
NUM STRING
1 中华人民共和国
2 人民当家作主
3 中华人民法律
4 共和国法制
5 法制社会
6 用法律维护利益
输入的中国这两个字是连续的，比如输入人民找到的数据为 1,2,3 展开

 我来答

1个回答

#热议# 为什么说不要把裤子提到肚脐眼？

ExcelPower
2016-12-07 · 专业Excel公式图表数据分析VBA

ExcelPower

采纳数：4495 获赞数：11863

向TA提问私信TA

关注

展开全部

 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