|   |   |
|---|---|
|参考文献|[http://club.excelhome.net/thread-725909-1-1.html](http://club.excelhome.net/thread-725909-1-1.html)|
 
Sub Macro1()  
Dim arr(), c As Range, firstAddress$, sh As Worksheet, s$, m&  
s = Application.InputBox("请输入查找内容", "请输入", Type:=2)  
If s = "" Then Exit Sub  
For Each sh In Sheets  
If sh.Name \<\> "result" Then  
With sh.UsedRange  
Set c = .Find(s, , , xlPart)  
If Not c Is Nothing Then  
firstAddress = c.Address  
Do  
m = m + 1  
ReDim Preserve arr(1 To 3, 1 To m)  
arr(1, m) = sh.Name  
arr(2, m) = c.Address(0, 0)  
arr(3, m) = c.Value  
Set c = .FindNext(c)  
Loop While Not c Is Nothing And c.Address \<\> firstAddress  
End If  
End With  
End If  
Next  
ActiveSheet.UsedRange.ClearContents  
If m \> 0 Then  
[a1].Resize(m, 3) = WorksheetFunction.Transpose(arr)  
With ActiveSheet  
For i = 1 To m  
.Hyperlinks.Add Anchor:=.Cells(i, 3), Address:="", SubAddress:=arr(1, i) & "!" & arr(2, i), TextToDisplay:=arr(3, i)  
Next  
End With  
End If  
End Sub

|   |   |
|---|---|
|参考文件|[https://www.cnblogs.com/yougewe/p/6911982.html](https://www.cnblogs.com/yougewe/p/6911982.html)|
|个人心得||