[已解决]模糊查找运行不正常请求帮助

huangxuejin · 发表于 2016-12-5 19:55

本帖最后由 huangxuejin 于 2016-12-5 21:55 编辑

一、现在两个模糊条件都要输入才运行正常，只输入一个就会乱成一团，

希望效果是：1、只输入一个条件：‘香樟’各个公司有‘香樟’的不管规格有几种都复制到结果表里，
2、输入两个条件：‘香樟’和‘胸径12(350)’各个公司只有‘香樟胸径12(350)’的都复制到结果表里，

二、此代码是本论坛下载的本白痴改了点，我查遍本论坛没找着合适的，希望哪位老师看看能帮到我的忙，在此先谢谢了，

三、因为有64家公司合作，每家公司都独立建一个工作表共有65个表，

最佳答案

月排行榜 / 总排行榜

苏子龙

2016-12-5 20:47

Sub tt()
Dim arr, brr, i&, j%, strCz$
Dim sh As Worksheet, s&
ReDim brr(1 To 10000, 1 To 10)
strCz = "*" & [b3] & "*" & [b4] & "*"
[c3:l2000] = ""
For Each sh In Sheets
If sh.Name <> "查询" Then
arr = sh.Range("b3:k" & sh.[c65536].End(3).Row)
For i = 2 To UBound(arr)
If arr(i, 3) & arr(i, 4) Like strCz Then
s = s + 1
For j = 1 To UBound(arr, 2)
brr(s, j) = arr(i, j)
Next
End If
Next
End If
Next
If s Then Range("c3").Resize(s, 10) = brr
End Sub

复制代码

跳转到最佳答案楼层

苏子龙 · 发表于 2016-12-5 20:47

Sub tt()
Dim arr, brr, i&, j%, strCz$
Dim sh As Worksheet, s&
ReDim brr(1 To 10000, 1 To 10)
strCz = "*" & [b3] & "*" & [b4] & "*"
[c3:l2000] = ""
For Each sh In Sheets
If sh.Name <> "查询" Then
arr = sh.Range("b3:k" & sh.[c65536].End(3).Row)
For i = 2 To UBound(arr)
If arr(i, 3) & arr(i, 4) Like strCz Then
s = s + 1
For j = 1 To UBound(arr, 2)
brr(s, j) = arr(i, j)
Next
End If
Next
End If
Next
If s Then Range("c3").Resize(s, 10) = brr
End Sub

复制代码

huangxuejin · 发表于 2016-12-5 22:00

感谢子龙老师第一时间为我排忧解难，帮我解决了难题，我代表公司对你崇高的敬意，深表的感谢，谢谢谢谢

		自动登录	找回密码
密码			注册

[已解决]模糊查找运行不正常请求帮助

评分