[已解决]多个关键词的模糊查询

terryche

如附件所示，当输入以空格分隔的多个字段时，可在结果区显示出符合条件的结果，最重要的是末尾超链接依然有效。
也可以用窗体制作。在论坛搜索多日，都是单个关键词的模查询，关于此多个关键词的模糊查询，还望众位高手不吝赐教。
多谢！

Copy of Fare Index.rar (12.28 KB, 下载次数: 68)

2015-1-19 11:09 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2015-1-19 14:08

在兰版的基础再处理了一下，一是保留了超链接，二是不分大小写，三是查询栏所列的所有条件都满足后才输出（兰版的只要满足一个就输出）

跳转到最佳答案楼层

雪舞子

楼主测试

Copy of Fare Index.rar (19.85 KB, 下载次数: 59)

2015-1-19 13:14 上传

点击文件名下载附件

蓝桥玄霜

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Address <> "$B$2" Then Exit Sub
   
3. Dim n&, Arr, i&, j&, y&
   
4. [b4:h16].ClearContents
   
5. aa = Split(Target.Value): n = 3
   
6. Arr = [b18].CurrentRegion
   
7. For i = 2 To UBound(Arr)
   
8.     For j = 1 To UBound(Arr, 2)
   
9.     For y = 0 To UBound(aa)
   
10.         If InStr(Arr(i, j), aa(y)) Then
    
11.             n = n + 1
    
12.             Cells(n, 2).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, i, 0): GoTo 100
    
13.         End If
    
14.     Next
    
15.     Next
    
16. 100:
    
17. Next
    
18. End Sub
    

复制代码

grf1973

在兰版的基础再处理了一下，一是保留了超链接，二是不分大小写，三是查询栏所列的所有条件都满足后才输出（兰版的只要满足一个就输出）

grf1973

代码如下：

1. rivate Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address <> "$$B$$2" Then Exit Sub
   
3.     Dim n&, Arr, i&, j&, y&
   
4.     Dim Flag As Boolean
   
5.     [b4:h16].ClearContents
   
6.     aa = Split(Target.Value): n = 3
   
7.     Arr = [b18].CurrentRegion
   
8.     For i = 2 To UBound(Arr)
   
9.         Flag = True
   
10.         x = Join(Application.Index(Arr, i), "")
    
11.         For y = 0 To UBound(aa)
    
12.             If InStr(UCase(x), UCase(Trim(aa(y)))) = 0 Then Flag = False: Exit For
    
13.         Next
    
14.         If Flag = True Then
    
15.             n = n + 1
    
16.             Cells(i + 17, 2).Resize(1, UBound(Arr, 2)).Copy Cells(n, 2)
    
17.         End If
    
18.     Next
    
19. End Sub
    

复制代码

terryche

感谢各位的精彩解答。对于此提问，还是grf1973 最能符合要求。

terryche

grf1973 发表于 2015-1-19 14:08
在兰版的基础再处理了一下，一是保留了超链接，二是不分大小写，三是查询栏所列的所有条件都满足后才输出（ ...

非常感谢！运行十分成功。
有一事想要追问一下，如果需要检索的数据在多个不同的sheet中，需要如何修改呢？

grf1973

再套一重循环

ytlrz6903

各位大侠好，我不会VBA，不过这个表格帮了我大忙，现在我麻烦的事情还是 数据库必须要一个一个往这个表格下面输入，大侠们能不能把这个表格下方的数据库部分做成一个链接，可以很方面的从另一个EXCEL文件里比如我桌面的DATA.XLS 搜索呢？谢谢了

ytlrz6903

还有一个问题，如果查询到的结果数目大于显示区域的数目，显示结果会溢出显示区域，将下面数据都给抹掉了，能不能调整为如果查询的结果大于显示区域的数目，只出现显示区域中的结果，多余的不显示，就是多余的不要覆盖下面的数据输入里面