Projects need recently, wrote a small tool, find the folder all excel, able to case-insensitive, does not distinguish between the Angle of half Angle, inside the cell and container search to find the content of the
to share with youPrivate Sub searchEnvorement_Click ()
Dim Dic, Wb As Workbook, Ws As Worksheet, Arr, N& , FN $% listsize Rng As Range, Str2 $, groupcount %, keyList () As String, no1 %
No1=0

The Set THSWB=ThisWorkbook. ActiveSheet
The Set Dic=CreateObject (" scripting. The dictionary ")
MyPath=THSWB. Range (H2)
Listsize=THSWB. Range (" A65536 "). The End (xlUp). Row
ReDim keyList (listsize - 1)

If Right (MyPath, 1) & lt;> "" Then
MyPath=MyPath & amp; ""
End the If
For I=1 To listsize
'search keyword
KeyList (I - 1)=Worksheets (" keyList "). The Range (" A "& amp; I). The Value

Next I



Application. ScreenUpdating=False
On the Error Resume Next

FN=Dir (MyPath & amp; * "" *. XLS)

The Do While FN & lt;> "
"
If FN & lt;> ThisWorkbook. Name Then
The Set Wb=CreateObject (MyPath & amp; FN)

For j=0 To listsize - 1

SearchKey=keyList (j)

With Wb
For Each Ws In the Worksheets
With the Ws
If InStr (1,. UsedRange, searchKey, 1) Then
The Set of Rng=. UsedRange. Find (searchKey,,,,,,, False)
Do
Str2=Wb. Name & amp; VbTab & amp; Ws. The Name & amp; VbTab & amp; The Replace (Rng) Address, "$"," ") & amp; VbTab & amp; Rng. Value & amp; VbTab & amp; SearchKey
If Not Dic. The exists (Str2) Then Dic. Add Str2, ""
The Set Rng=. UsedRange. Find (searchKey Rng,,,,,, False)
Loop While. UsedRange. Find (searchKey,,,,,,, False). Address & lt;> Rng. Address
End the If

For Each Sp. In Shapes
If Sp. Type & lt;> 6 And InStr (1, Sp. TextEffect. Text, searchKey, 1) Then
Str2=Wb. Name & amp; VbTab & amp; Ws. The Name & amp; VbTab & amp; VbTab & amp; Sp., the Name & amp; ":" & amp; Sp. TextEffect. Text & amp; VbTab & amp; SearchKey
If Not Dic. The exists (Str2) Then Dic. Add Str2, ""
End the If
If Sp. Type=6 Then
Groupcount=Sp. GroupItems. Count
For k=1 To groupcount
If InStr (1, Sp. GroupItems (k) TextEffect. Text, searchKey, 1) Then
Str2=Wb. Name & amp; VbTab & amp; Ws. The Name & amp; VbTab & amp; VbTab & amp; Sp. GroupItems (k). The Name & amp; ":" & amp; Sp. GroupItems (k). TextEffect. Text & amp; VbTab & amp; SearchKey
If Not Dic. The exists (Str2) Then Dic. Add Str2, ""
End the If
Next k
End the If
Next Sp
End With
Next the Ws

End With

Next j
No1=+ 1
no.Wb. Close False
End the If

FN=Dir
The Set Wb=Nothing
Loop


Worksheets. Add
ActiveSheet. Name="searchList
"With Worksheets (" searchList ")
Rows (" 3: "& amp; . Rows. Count). The Clear
Cells (2, 1)="mash"
Cells (2, 2)="file"
Cells (2, 3)="sheet"
Cells (2, 4)="cell"
Cells (2, 5)="content"
Cells (2, 6)="search keyword"
Cells (2, 1). Interior. ColorIndex=4
Cells (2, 2). Interior. ColorIndex=4
Cells (2, 3). Interior. ColorIndex=4
Cells (2, 4). Interior. ColorIndex=4
Cells (2, 5). Interior. ColorIndex=4
Cells (2, 6). Interior. ColorIndex=4
If Dic. Count & gt; 0 Then
Arr=Dic. Keys
For N=LBound (Arr) To UBound (Arr)
Cells (N + 3, 1)=N + 1
Cells (N + 3, 2). The Resize (1, 5)=Split (Arr (N), vbTab)
The Next N
. [a3]. Resize (N, 6). The Borders. Graphics.linestyle=1
The Else
Cells (3, 1)="retrieve content has not been found"
End the If
End With
MsgBox (" over "& amp; VbCrLf & amp; No1)
End Sub