ActiveSheet.Next.Select
' ============================================================= ' 提示您是否想高亮显示已查找到的单元格
If MsgBox(\您想加阴影高亮显示所有查找到的单元格吗?\, vbYesNo, _ \加阴影高亮显示单元格\) = vbNo Then ' 如果不想加阴影显示单元格,则将变量bTag值设置为False bTag = False End If
' ============================================================= i = 2
' 开始在工作簿的所有工作表中搜索 On Error Resume Next
For Each wks In ActiveWorkbook.Worksheets
If wks.Cells.SpecialCells(xlCellTypeConstants).Count = 0 Then GoTo NoSpecCells
For Each rCell In wks.Cells.SpecialCells(xlCellTypeConstants) DoEvents
If rCell.Value = szLookupVal Then ' 添加找到的单元格地址到新工作表中
rCell.Hyperlinks.Add Sheets(\查找结果\).Cells(i, 1), \, \ & wks.Name & \ & rCell.Address
' 检查条件判断值bTag,以决定是否加亮显示单元格 Select Case bTag Case True
rCell.Interior.ColorIndex = 19 End Select i = i + 1
.StatusBar = \查找到的单元格数为: \ & i - 2 End If Next rCell NoSpecCells: Next wks
' 如果没有找到匹配的值,则移除新增工作表 If i = 2 Then
MsgBox \您所要查找的数值{\ & szLookupVal & \在这些工作表中没有发现\, 64, \没有匹配值\
Sheets(\查找结果\).Delete End If
.Calculation = xlCalculationAutomatic .DisplayAlerts = True
.ScreenUpdating = True .StatusBar = Empty End With End Sub
6. 其它一些查找方法 可以使用For Each ? Next语句和Like运算符进行更精确匹配的查找。例如，下列代码在单元格区域A1:A10中查找以字符“我”开头的单元格，并将其背景色变为红色。
Sub test()
Dim Cell As Range
For Each Cell In [A1:A10] If Cell Like \我*\ Then
Cell.Interior.ColorIndex = 3 End If Next End Sub
可以输入如下图5所示的数据进行测试。
7. 扩展Find方法
我们能够使用Find方法查找单元格区域的数据，但是没有一个方法能够返回一个Range对象，该对象引用了含有所查找数据的所有单元格，下面提供了一个FindAll函数来实现此功能。此外，Find方法的另一个不足之处是不支持通配符字符串，下面也提供了一个
WildCardMatchCells函数，返回一个Range对象，引用了与所提供的通配符字符串相匹配的单元格。通配符字符串可以是有效使用在Like运算符中的任何字符串。
7.1 FindAll函数
这个程序在参数SearchRange所代表的区域中查找所有含有参数FindWhat代表的值的单元格，SearchRange参数必须是一个单独的单元格区域对象，FindWhat参数是想要查找的值，其它参数是可选的且与Find方法的参数意思相同。 FindAll函数的代码如下：
Option Compare Text
Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _ Optional MatchCase As Boolean = False) As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''
' 返回SearchRange区域中含有FindWhat所代表的值的所有单元格组成的Range对象 ' 其参数与Find方法的参数相同 ' 如果没有找到单元格,将返回Nothing.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCell As Range Dim FoundCells As Range Dim LastCell As Range Dim FirstAddr As String With SearchRange
Set LastCell = .Cells(.Cells.Count) End With
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _ LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then Set FoundCells = FoundCell FirstAddr = FoundCell.Address Do
Set FoundCells = Application.Union(FoundCells, FoundCell) Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr) End If
If FoundCells Is Nothing Then Set FindAll = Nothing Else
Set FindAll = FoundCells End If End Function 使用上面代码的示例： Sub TestFindAll()
Dim SearchRange As Range Dim FoundCells As Range Dim FoundCell As Range Dim FindWhat As Variant Dim MatchCase As Boolean Dim LookIn As XlFindLookIn Dim LookAt As XlLookAt
Dim SearchOrder As XlSearchOrder
Set SearchRange = ThisWorkbook.Worksheets(1).Range(\) FindWhat = \ '要查找的文本,可根据实际情况自定
LookIn = xlValues LookAt = xlPart
SearchOrder = xlByRows MatchCase = False
Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat, _ LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If FoundCells Is Nothing Then Debug.Print \没有找到!\ Else
For Each FoundCell In FoundCells.Cells
Debug.Print FoundCell.Address, FoundCell.Text Next FoundCell End If End Sub
上面的代码中，列出了查找区域中含有所要查找的数据的所有单元格的地址以及相应文本。不仅可以找出所有含有所查找数据的单元格地址，而且也可以对这些单元格进行一系列操作，如格式化、更改数据等。 7.2 WildCardMatchCells函数
这个程序查找参数SearchRange所代表的区域中所有单元格，使用Like运算符将它们的值与参数CompareLikeString所代表的值比较。参数SearchRange必须是一个单独的区域，参数CompareLikeString是想要比较的文本的格式。该函数使用单元格的Text属性而不是Value属性。可选参数SearchOrder和MatchCase与Find方法中的参数意义相同。 该函数返回一个Range对象，该对象包含对与参数CompareLikeString相匹配的所有单元格的引用。如果没有匹配的单元格，则返回Nothing。
因为Find方法不支持通配符，程序将循环所有的单元格，因此对于包含大量数据的区域，执行时间可能是一个问题。并且，如果参数MatchCase为False或忽略该参数，文本在程序中必须被转换成大写，以便于查找时不区分大小写(即“A”=“a”)，因此，此时程序运行将更慢。
WildCardMatchCells函数的代码如下：
Function WildCardMatchCells(SearchRange As Range, CompareLikeString As String, _
Optional SearchOrder As XlSearchOrder = xlByRows, _ Optional MatchCase As Boolean = False) As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 本程序返回文本值与通配符字符串相匹配的单元格引用 ' 返回SearchRange区域中所有相匹配的单元格 ' 匹配的条件是参数CompareLikeString
' 使用了VBA中的LIKE运算符
' 如果没有相匹配的单元格或指定了一个无效的参数,则返回Nothing. '
' 参数SearchOrder指定查找的方向;逐行还是逐列(SearchOrder:=xlByRows或SearchOrder:=xlByColumns
' 参数MatchCase指定是否区分大小写(MatchCase:=True, \或(MatchCase:=False,\'
' 不需要在模块顶指定\如果指定的话,将不会正确执行大小写比较 '
' 执行单元格中的Text属性比较,而不是Value属性比较
' 因此,仅比较显示在屏幕中的文本,而不是隐藏在单元格中具体的值 '
' 如果参数SearchRange是nothing或多个区域,则返回Nothing.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCells As Range Dim FirstCell As Range Dim LastCell As Range Dim RowNdx As Long Dim ColNdx As Long Dim StartRow As Long Dim EndRow As Long Dim StartCol As Long Dim EndCol As Long Dim WS As Worksheet Dim Rng As Range
' 确保参数SearchRange不是Nothing且是一个单独的区域 If SearchRange Is Nothing Then Exit Function End If
If SearchRange.Areas.Count > 1 Then Exit Function End If
With SearchRange Set WS = .Worksheet Set FirstCell = .Cells(1)
Set LastCell = .Cells(.Cells.Count) End With
StartRow = FirstCell.Row StartCol = FirstCell.Column