跨工作簿查找并列表显示查询结果

钓鱼换酒

工作中每年度都会有不少的工作报表产生，要想查找客户的购买明细会非常麻烦。
请大神们帮忙做个跨工作簿查找的代码实现：
输入要查询的关键词或电话号码或联系人名字，点击按钮查询，在下方表格中显示查询内容出现的工作簿名称（带超链）、工作表名称，所在的行号。具体附件已上传。
先谢谢各位大神了！

活在理想的世界

再如何你也得做个样子吧？比如你的关键词是什么？这个关键词带来的结果是什么？

钓鱼换酒

活在理想的世界 发表于 2017-12-25 15:31
再如何你也得做个样子吧？比如你的关键词是什么？这个关键词带来的结果是什么？

大神，搜索的是：客户名称或者是客户电话，或者客户联系人

活在理想的世界

钓鱼换酒 发表于 2017-12-25 15:38
大神，搜索的是：客户名称或者是客户电话，或者客户联系人

那超链接是什么意思呢？行号又要他做什么？

我遍历完以后肯定是把找到的所有数据刷进指定表（详细内容），又为什么要超链接和行号？

超链接要跨文件夹打开工作簿定位到指定单元格？没必要了吧？内容已经到你的表内了？

所以我实在不太理解楼主的意思。

钓鱼换酒

活在理想的世界 发表于 2017-12-25 15:47
那超链接是什么意思呢？行号又要他做什么？

我遍历完以后肯定是把找到的所有数据刷进指定表（详细内容 ...

我这个表并不是自己一个人来统计，有的同事的格式是不一样的，比如有合并单元格，有的会是采用几行才是一个完整的销售信息，提取过来没有标准行数可确定。
超级链接当然是点击后可自动打开这个工作簿了，因为有的同事会一年就生成12个单独工作簿来记录。
工作表名称、行号是为了便于锁定关键词所出现的位置。
我附件中只是模拟了几个表格，对于老销售员可能会使十几年的，而且记录的方式都会不一样，如联系电话可能在第一列，也可能在最后一列。
大神，不知我讲明白没有？
也谢谢您的关注！感谢！

此用户被禁言

只针对你所提供的文件。至于合并的单元格没有考虑。。。

如果还有其它的什么特殊要求的格式，或者变动太多的，我不负责修改了。。我做的只针对你所提供的文件

遍历查询.zip (72.34 KB, 下载次数: 230)

2017-12-25 16:19 上传

点击文件名下载附件

活在理想的世界

钓鱼换酒 发表于 2017-12-25 16:03
我这个表并不是自己一个人来统计，有的同事的格式是不一样的，比如有合并单元格，有的会是采用几行才是一 ...

刚看了一下，你的问题涉及的不止一个工作簿？涉及的工作表就更多了。难道你要一个一个点开看吗？

当然了，100%满足你的希望并不难，超链接也不是问题，问题是你要一个一个点开看吗？

你就这几个工作簿？如果再多一点你点的完吗？

鄂龙蒙

1. Sub 指定文件夹下多薄多表逐个取数()
   
2.     Dim wb As Workbook, Sht As Worksheet
   
3.     Set Sht = Sheet1
   
4.     sa = Sht.[A2]
   
5.     Sht.UsedRange.Offset(5, 0).ClearContents
   
6.     Application.ScreenUpdating = False
   
7.     f = Dir(ThisWorkbook.Path & "\销售记录\*.xls*")
   
8.         Do While f <> ""
   
9.                 Set wb = Workbooks.Open(ThisWorkbook.Path & "\销售记录" & f)
   
10.                 n = n + 1
    
11.                 For Each sh In wb.Sheets
    
12.                     m = m + 1
    
13.                     For i = 2 To sh.[A1048576].End(3).Row
    
14.                         If sh.Cells(i, 4) Like "*" & sa & "*" Or sh.Cells(i, 5) Like "*" & sa & "*" Then
    
15.                             t = t + 1
    
16.                             Sht.Cells(t + 5, 1) = wb.Name
    
17.                             Sht.Cells(t + 5, 2) = sh.Name
    
18.                             Sht.Cells(t + 5, 3) = i
    
19.                             Sht.Cells(t + 5, 4) = sh.Cells(i, 4)
    
20.                             Sht.Cells(t + 5, 5) = sh.Cells(i, 5)
    
21.                         End If
    
22.                     Next
    
23.                 Next
    
24.                 m = 0
    
25.                 wb.Close False
    
26.             f = Dir
    
27.         Loop
    
28.     MsgBox "共查询了  " & n & "  个工作薄  " & n & "  个工作表 ，找到符合条件的  " & t & "  行数据 。"
    
29.     Application.ScreenUpdating = True
    
30. End Sub

复制代码

钓鱼换酒

此用户被禁言 发表于 2017-12-25 16:20
只针对你所提供的文件。至于合并的单元格没有考虑。。。

如果还有其它的什么特殊要求的格式，或者变动太 ...

完全符合我的要求，做得太棒了，太棒了，太棒了，非常感谢，语句备注也非常到位！
太感谢了！
也谢谢“活在理想的世界”的无私帮助！
谢谢！

活在理想的世界

这是全自动更新的，你自己改名字，在工作簿名字上点点试试吧。