引：

关键字查找的时候，需要跨表等一系列操作才能找到。

这段代码解决了跨表关键字的搜索，并在活动的表中列出你搜索的关键字列出连接

效果演示：

代码如下：

Sub 关键字() '关键字整张工作薄搜索并归总

' 定义变量

Dim ws As Worksheet

Dim searchRange As Range

Dim searchText As String

Dim matchingCells As Collection

Dim cell As Range, targetCell As Range, valueCell As Range

Dim i As Integer

' 弹出 input box，要求输入要搜索的文本

searchText = InputBox("请输入您要搜索的文本：")

' 初始化匹配单元格集合

Set matchingCells = New Collection

' 在整个工作簿中搜索所有单元格

For Each ws In ThisWorkbook.Worksheets

Set searchRange = ws.UsedRange

For Each cell In searchRange

If InStr(1, cell.Text, searchText, vbTextCompare) > 0 Then

' 将匹配单元格添加到集合中

matchingCells.Add cell

End If

Next cell

Next ws

' 检查是否有匹配单元格

If matchingCells.Count > 0 Then

' 提示选择存放结果的单元格

Set targetCell = Application.InputBox("请选择一个空白单元格，来存放搜索结果", Type:=8)

' 如果所选单元格不合法，则退出子程序

If targetCell Is Nothing Then Exit Sub

' 插入标题

targetCell.Value = "关键词"

targetCell.Offset(0, 2).Value = "匹配的单元格内容"

targetCell.Offset(0, 1).Value = "连接"

' 循环遍历匹配单元格集合

i = 0

For Each cell In matchingCells

i = i + 1

Set valueCell = targetCell.Offset(i, 0)

' 在目标单元格中插入关键字和匹配到的内容，并将匹配单元格转换为超链接

valueCell.Value = searchText

valueCell.Offset(0, 1).Value = cell.Value

targetCell.Offset(i, 2).Value = cell.Value

ThisWorkbook.FollowHyperlink "#" & "'" & cell.Parent.Name & "'" & "!" & cell.Address

targetCell.Offset(i, 2).Worksheet.Hyperlinks.Add Anchor:=valueCell.Offset(0, 1), Address:="", _

SubAddress:="'" & cell.Parent.Name & "'!" & cell.Address, _

TextToDisplay:=cell.Parent.Name & " " & cell.Address

Next cell

Else

' 如果没有匹配单元格，弹出一个消息框提示

MsgBox "没有找到匹配单元格。"

End If

End Sub