怎么样实现跨表的模糊搜索

zhaogang1960

夏末初至 发表于 2016-2-19 08:57
嗯，上传了，版主大大看下

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B6" And Target.Address(0, 0) <> "B7" Then Exit Sub
    If [b6] = "" Or [b7] = "" Then Exit Sub
    Dim arr, brr(1 To 100000, 1 To 2), i&, m&, t1$, t2$, sh As Worksheet
    t1 = [b6]
    t2 = [b7]
    For Each sh In Worksheets
        If sh.Name <> "首页" Then
            arr = sh.Range("B5:C" & sh.Range("B" & Rows.Count).End(xlUp).Row)
            For i = 1 To UBound(arr)
                If InStr(arr(i, 1), t1) > 0 And InStr(arr(i, 2), t2) > 0 Then
                    m = m + 1
                    brr(m, 1) = arr(i, 1)
                    brr(m, 2) = arr(i, 2)
                End If
            Next
        End If
    Next
    Range("A9:B" & Rows.Count).ClearContents
    If m > 0 Then Range("A9").Resize(m, 2) = brr
End Sub

zhaogang1960

附件
跨表模糊查询.rar (20.3 KB, 下载次数: 78)

2016-2-19 09:50 上传

点击文件名下载附件

zhaogang1960

上面关键字要求包含，如“跨表模糊查询1”中包含“跨表模糊查询”
下面程序   “跨表查询1”   也可以看作包含在  “跨表模糊查询1”  中
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B6" And Target.Address(0, 0) <> "B7" Then Exit Sub
    If [b6] = "" Or [b7] = "" Then Exit Sub
    Dim arr, brr(1 To 100000, 1 To 2), i&, m&, t1$, t2$, sh As Worksheet
    t1 = [b6]
    t2 = [b7]
    With CreateObject("VBSCRIPT.REGEXP")
        .Global = True
        .Pattern = "(.|$)"
        For Each sh In Worksheets
            If sh.Name <> "首页" Then
                arr = sh.Range("B5:C" & sh.Range("B" & Rows.Count).End(xlUp).Row)
                For i = 1 To UBound(arr)
                    If arr(i, 1) Like .Replace(t1, "*$1") And InStr(arr(i, 2), t2) > 0 Then
                        m = m + 1
                        brr(m, 1) = arr(i, 1)
                        brr(m, 2) = arr(i, 2)
                    End If
                Next
            End If
        Next
    End With
    Range("A8:B" & Rows.Count).ClearContents
    If m > 0 Then Range("A8").Resize(m, 2) = brr
End Sub

zhaogang1960

请看附件
跨表模糊查询.rar (21.01 KB, 下载次数: 57)

2016-2-19 10:03 上传

点击文件名下载附件

okendeavor

请问如何关键字窗口设计成用户界面利用表单控件？

夏末初至

zhaogang1960 发表于 2016-2-19 10:01
上面关键字要求包含，如“跨表模糊查询1”中包含“跨表模糊查询”
下面程序   “跨表查询1”   也可以看作 ...

版主大大，出现了点小问题，就是 如果我的答复内容比较多的时候，就搜索不到，显示不出来了，但是测试了下，我的问题文字很多很多，只要答复的内容很短，他就能搜索出来，这是什么原因呢？

zhaogang1960

夏末初至 发表于 2016-2-19 16:35
版主大大，出现了点小问题，就是 如果我的答复内容比较多的时候，就搜索不到，显示不出来了，但是测试了 ...

我这里测试正常，共有5行数据

首先要让帮助你的人知道你的具体要求，我的理解是B6是查找c列，B7是查找d列，且须同时满足条件

夏末初至

zhaogang1960 发表于 2016-2-19 16:41
我这里测试正常，共有5行数据

首先要让帮助你的人知道你的具体要求，我的理解是B6是查找c列，B7是查找 ...

太谢谢版主了，之前不好意思没有说清楚，我的意思是，首页B6模糊查询除了首页外其他所有表格的B列，只要我输入的文字包含在B列其中的一个问题里面，就在首页，问题和答复下面一一显示对应查询到的问题和答复.。记录的问题统一在其他表格的B列，答复统一在C.

zhaogang1960

夏末初至 发表于 2016-2-19 17:04
太谢谢版主了，之前不好意思没有说清楚，我的意思是，B6模糊查询B列，只要我输入的文字包含在B列其中的一 ...

B6模糊查询C列，B7模糊查询B列，那么，在C列中差 33，在B列中差 答复Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B6" And Target.Address(0, 0) <> "B7" Then Exit Sub
    If [b6] = "" Or [b7] = "" Then Exit Sub
    Dim arr, brr(1 To 100000, 1 To 2), i&, m&, t1$, t2$, sh As Worksheet
    t2 = [b6]
    t1 = [b7]
    With CreateObject("VBSCRIPT.REGEXP")
        .Global = True
        .Pattern = "(.|$)"
        For Each sh In Worksheets
            If sh.Name <> "首页" Then
                arr = sh.Range("B5:C" & sh.Range("B" & Rows.Count).End(xlUp).Row)
                For i = 1 To UBound(arr)
                    If arr(i, 1) Like .Replace(t1, "*$1") And InStr(arr(i, 2), t2) > 0 Then
                        m = m + 1
                        brr(m, 1) = arr(i, 1)
                        brr(m, 2) = arr(i, 2)
                    End If
                Next
            End If
        Next
    End With
    Range("A8:B" & Rows.Count).ClearContents
    If m > 0 Then Range("A8").Resize(m, 2) = brr
End Sub


结果当然是什么也没有查到：
跨表模糊查询-包含关键字.rar (28.95 KB, 下载次数: 72)

2016-2-19 17:12 上传

点击文件名下载附件

夏末初至

zhaogang1960 发表于 2016-2-19 17:11
B6模糊查询C列，B7模糊查询B列，那么，在C列中差 33，在B列中差 答复Private Sub Worksheet_Change(ByVal ...

终于明白了，版主大大，非常谢谢版主啊，突然有了一个更好想法， 版主大大如果想要其中一个满足就算满足，也就是说，B6查询B列，B7查询C列，另外一个可以为空格（不输入），在原来的代码基础上要怎么改啊