Find方法应用大全

本文整理了以前的一些关于Find方法的文章，作为Excel VBA应用大全的一部分。

1. Find方法的作用

使用VBA在工作表或单元格区域中查找某项数据时，我们通常使用For…Next循环，这在小范围中使用还可以，但应用在大量数据中查找时，会耗费较多时间。

而在Excel工作表中，通常使用菜单“编辑>>查找”命令或按Ctrl+F组合键，在“查找和替换”对话框中来迅速查找所需的数据。在VBA中，我们也能使用这种方法，即Find方法，这在下面的内容中介绍。

Find方法将在指定的单元格区域中查找包含参数指定数据的单元格，若找到符合条件的数据，则返回包含该数据的单元格；若未发现相匹配的数据，则返回Nothing。该方法返回一个Range对象，在使用该方法时，不影响选定区域或活动单元格。

为什么要使用Find方法呢？最主要的原因是查找的速度。如果要使用VBA代码在包含大量数据的单元格区域中查找某项数据，应该使用Find方法。

例如，在工作表Sheet1的单元格IV65536中输入fanjy，然后运行下面的代码：

Sub QuickSearch()

    If Not Sheet1.Cells.Find("fanjy") Is Nothing Then MsgBox "已找到fanjy!"

End Sub

再试试下面的代码：

Sub SlowSearch()

    Dim R As Range

    For Each R In Sheet1.Cells

        If R.Value = "fanjy" Then MsgBox "已找到fanjy!"

    Next R

End Sub

比较一下两段代码的速度，可知第一段代码运行很快，而第二段代码却要执行相当长的一段时间。

2. Find方法的语法

[语法]

<单元格区域>.Find (What，[After]，[LookIn]，[LookAt]，[SearchOrder]，[SearchDirection]，[MatchCase]，[MatchByte]，[SearchFormat])

[参数说明]

(1)<单元格区域>，必须指定，返回一个Range对象。

(2)参数What，必需指定。代表所要查找的数据，可以为字符串、整数或者其它任何数据类型的数据。对应于“查找与替换”对话框中，“查找内容”文本框中的内容。

(3)参数After，可选。指定开始查找的位置，即从该位置所在的单元格之后向后或之前向前开始查找(也就是说，开始时不查找该位置所在的单元格，直到Find方法绕回到该单元格时，才对其内容进行查找)。所指定的位置必须是单元格区域中的单个单元格，如果未指定本参数，则将从单元格区域的左上角的单元格之后开始进行查找。

(4)参数LookIn，可选。指定查找的范围类型，可以为以下常量之一：xlValues、xlFormulas或者xlComments，默认值为xlFormulas。对应于“查找与替换”对话框中，“查找范围”下拉框中的选项。

(5)参数LookAt，可选。可以为以下常量之一：XlWhole或者xlPart，用来指定所查找的数据是与单元格内容完全匹配还是部分匹配，默认值为xlPart。对应于“查找与替换”对话框中，“单元格匹配”复选框。

(6)参数SearchOrder，可选。用来确定如何在单元格区域中进行查找，是以行的方式(xlByRows)查找，还是以列的方式(xlByColumns)查找，默认值为xlByRows。对应于“查找与替换”对话框中，“搜索”下拉框中的选项。

(7)参数SearchDirection，可选。用来确定查找的方向，即是向前查找(XlPrevious)还是向后查找(xlNext)，默认的是向后查找。

(8)参数MatchCase，可选。若该参数值为True，则在查找时区分大小写。默认值为False。对应于“查找与替换”对话框中，“区分大小写”复选框。

(9)参数MatchByter，可选。即是否区分全角或半角，在选择或安装了双字节语言时使用。若该参数为True，则双字节字符仅与双字节字符相匹配；若该参数为False，则双字节字符可匹配与其相同的单字节字符。对应于“查找与替换”对话框中，“区分全角/半角”复选框。

(10)参数SearchFormat，可选，指定一个确切类型的查找格式。对应于“查找与替换”对话框中，“格式”按钮。当设置带有相应格式的查找时，该参数值为True。

(11)在每次使用Find方法后，参数LookIn、LookAt、SearchOrder、MatchByte的设置将保存。如果下次使用本方法时，不改变或指定这些参数的值，那么该方法将使用保存的值。

在VBA中设置的这些参数将更改“查找与替换”对话框中的设置；同理，更改“查找与替换”对话框中的设置，也将同时更改已保存的值。也就是说，在编写好一段代码后，若在代码中未指定上述参数，可能在初期运行时能满足要求，但若用户在“查找与替换”对话框中更改了这些参数，它们将同时反映到程序代码中，当再次运行代码时，运行结果可能会产生差异或错误。若要避免这个问题，在每次使用时建议明确的设置这些参数。

3. Find方法使用示例

3.1 本示例在活动工作表中查找what变量所代表的值的单元格，并删除该单元格所在的列。

Sub Find_Error()

  Dim rng As Range

  Dim what As String

  what = "Error"

  Do

    Set rng = ActiveSheet.UsedRange.Find(what)

    If rng Is Nothing Then

      Exit Do

    Else

       Columns(rng.Column).Delete

    End If

  Loop

End Sub

3.2 带格式的查找

本示例在当前工作表单元格中查找字体为”Arial Unicode MS”且颜色为红色的单元格。其中，Application.FindFormat对象允许指定所需要查找的格式，此时Find方法的参数SearchFormat应设置为True。

Sub FindWithFormat()

  With Application.FindFormat.Font

        .Name = "Arial Unicode MS"

        .ColorIndex = 3

  End With

  Cells.Find(what:="", SearchFormat:=True).Activate

End Sub

[小结] 在使用Find方法找到符合条件的数据后，就可以对其进行相应的操作了。您可以：

∙对该数据所在的单元格进行操作； 

∙对该数据所在单元格的行或列进行操作； 

∙对该数据所在的单元格区域进行操作。 

4. 与Find方法相联系的方法

可以使用FindNext方法和FindPrevious方法进行重复查找。在使用这两个方法之前，必须用Find方法指定所需要查找的数据内容。

4.1 FindNext方法

FindNext方法对应于“查找与替换”对话框中的“查找下一个”按钮。可以使用该方法继续执行查找，查找下一个与Find方法中所指定条件的数据相匹配的单元格，返回代表该单元格的Range对象。在使用该方法时，不影响选定区域或活动单元格。

4.1.1 语法

<单元格区域>.FindNext(After)

4.1.2 参数说明

参数After，可选。代表所指定的单元格，将从该单元格之后开始进行查找。开始时不查找该位置所在的单元格，直到FindNext方法绕回到该单元格时，才对其内容进行查找。所指定的位置必须是单元格区域中的单个单元格，如果未指定本参数，则将从单元格区域的左上角的单元格之后开始进行查找。

当查找到指定查找区域的末尾时，本方法将环绕至区域的开始继续查找。发生环绕后，为停止查找，可保存第一次找到的单元格地址，然后测试下一个查找到的单元格地址是否与其相同，作为判断查找退出的条件，以避免出现死循环。当然，如果在查找的过程中，将查找到的单元格数据进行了改变，也可不作此判断，如下例所示。

4.2 FindPrevious方法

可以使用该方法继续执行Find方法所进行的查找，查找前一个与Find方法中所指定条件的数据相匹配的单元格，返回代表该单元格的Range对象。在使用该方法时，不影响选定区域或活动单元格。

4.2.1 语法

<单元格区域>.FindPrevious(After)

4.2.2 参数说明

参数After，可选。代表所指定的单元格，将从该单元格之前开始进行查找。开始时不查找该位置所在的单元格，直到FindPrevious方法绕回到该单元格时，才对其内容进行查找。所指定的位置必须是单元格区域中的单个单元格，如果未指定本参数，则将从单元格区域的左上角的单元格之前开始进行查找。

当查找到指定查找区域的起始位置时，本方法将环绕至区域的末尾继续查找。发生环绕后，为停止查找，可保存第一次找到的单元格地址，然后测试下一个查找到的单元格地址是否与其相同，作为判断查找退出的条件，以避免出现死循环。

4.2.3 示例

在工作表中输入如下图1所示的数据，至少保证在A列中有两个单元格输入了数据“excelhome”。

图1：测试的数据

在VBE编辑器中输入下面的代码测试Find方法、FindNext方法、FindPrevious方法，体验各个方法所查找到的单元格位置。

Sub testFind()

  Dim findValue As Range

  Set findValue = Worksheets("Sheet1").Columns("A").Find(what:="excelhome")

  MsgBox "第一个数据发现在单元格:" & findValue.Address

  Set findValue = Worksheets("Sheet1").Columns("A").FindNext(After:=findValue)

  MsgBox "下一个数据发现在单元格:" & findValue.Address

  Set findValue = Worksheets("Sheet1").Columns("A").FindPrevious(After:=findValue)

  MsgBox "前一个数据发现在单元格" & findValue.Address

End Sub

5. 综合示例

[示例1]查找值并选中该值所在的单元格

[示例1-1]

Sub Find_First()

    Dim FindString As String

    Dim rng As Range

    FindString = InputBox("请输入要查找的值:")

    If Trim(FindString) <> "" Then

        With Sheets("Sheet1").Range("A:A")

            Set rng = .Find(What:=FindString, _

                            After:=.Cells(.Cells.Count), _

                            LookIn:=xlValues, _

                            LookAt:=xlWhole, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlNext, _

                            MatchCase:=False)

            If Not rng Is Nothing Then

                Application.Goto rng, True

            Else

                MsgBox "没有找到!"

            End If

        End With

    End If

End Sub

示例说明：运行程序后，将在工作表Sheet1的A列中查找InputBox函数输入框中所输入的值，并查找该值所在的第一个单元格，如果没有找到该值，则显示消息框“没有找到!”。语句Application.Goto rng, True的作用是将窗口滚动至该单元格，即该单元格位于当前窗口的左上方。

[示例1-2]

Sub Find_Last()

    Dim FindString As String

    Dim rng As Range

    FindString = InputBox("请输入要查找的值")

    If Trim(FindString) <> "" Then

        With Sheets("Sheet1").Range("A:A")

            Set rng = .Find(What:=FindString, _

                            After:=.Cells(1), _

                            LookIn:=xlValues, _

                            LookAt:=xlWhole, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlPrevious, _

                            MatchCase:=False)

            If Not rng Is Nothing Then

                Application.Goto rng, True

            Else

                MsgBox "Nothing found"

            End If

        End With

  End If

End Sub

示例说明：与上面的程序不同的是，运行该程序后，将在工作表Sheet1的A列中查找InputBox函数输入框中所输入的值，并选中该值所在的最后一个单元格。请比较代码中Find方法的参数。

[示例1-3]

Sub Find_Todays_Date()

    Dim FindString As Date

    Dim rng As Range

    FindString = Date

    With Sheets("Sheet1").Range("A:A")

        Set rng = .Find(What:=FindString, _

                        After:=.Cells(.Cells.Count), _

                        LookIn:=xlFormulas, _

                        LookAt:=xlWhole, _

                        SearchOrder:=xlByRows, _

                        SearchDirection:=xlNext, _

                        MatchCase:=False)

        If Not rng Is Nothing Then

            Application.Goto rng, True

        Else

            MsgBox "没有找到!"

        End If

    End With

End Sub

示例说明：运行程序后，将在工作表Sheet1的A列中查找日期所在的单元格，并选中第一个日期单元格。

[示例2]在B列中标出A列中有相应值的单元格

Sub Mark_cells_in_column()

    Dim FirstAddress As String

    Dim myArr As Variant

    Dim rng As Range

    Dim I As Long

    Application.ScreenUpdating = False

    myArr = Array("VBA")

    '也能够在数组中使用更多的值,如下所示

    'myArr = Array("VBA", "VSTO")

    With Sheets("Sheet2").Range("A:A")

        .Offset(0, 1).ClearContents

        '清除右侧单元格中的内容

        For I = LBound(myArr) To UBound(myArr)

            Set rng = .Find(What:=myArr(I), _

                            After:=.Cells(.Cells.Count), _

                            LookIn:=xlFormulas, _

                            LookAt:=xlWhole, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlNext, _

                            MatchCase:=False)

            '如要想查找rng.value中的一部分,可使用参数值xlPart

            '如果使用LookIn:=xlValues,也会处理公式单元格中与条件相同的值

            If Not rng Is Nothing Then

                FirstAddress = rng.Address

                Do

                    rng.Offset(0, 1).Value = "X"

                    '如果值VBA找到,则在该单元格的右侧列中的相应单元格作上标记

                    Set rng = .FindNext(rng)

                Loop While Not rng Is Nothing And rng.Address <> FirstAddress

            End If

        Next I

    End With

    Application.ScreenUpdating = True

End Sub

示例说明：运行程序后，将查找工作表Sheet2上A列中的每个单元格，并在值为“VBA”所在的单元格的右侧单元格中作出标记“X”。

[示例3]为区域中指定值的单元格填充颜色

Sub Color_cells_in_Range()

    Dim FirstAddress As String

    Dim MySearch As Variant

    Dim myColor As Variant

    Dim rng As Range

    Dim I As Long

    MySearch = Array("VBA")

    myColor = Array("3")

    '也能在数组中使用多个值

    'MySearch = Array("VBA", "Hello", "OK")

    'myColor = Array("3", "6", "10")

    With Sheets("Sheet3").Range("A1:C4")

        '将所有单元格中的填充色改为无填充色

        .Interior.ColorIndex = xlColorIndexNone

         For I = LBound(MySearch) To UBound(MySearch)

            Set rng = .Find(What:=MySearch(I), _

                            After:=.Cells(.Cells.Count), _

                            LookIn:=xlFormulas, _

                            LookAt:=xlWhole, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlNext, _

                            MatchCase:=False)

            '如果想查找rng.value的一部分,则使用参数值xlPart

            '如果使用LookIn:=xlValues,则也会处理公式单元格

            If Not rng Is Nothing Then

                FirstAddress = rng.Address

                Do

                    rng.Interior.ColorIndex = myColor(I)

                    Set rng = .FindNext(rng)

                Loop While Not rng Is Nothing And rng.Address <> FirstAddress

            End If

        Next I

    End With

End Sub

示例说明：运行程序后，将在工作表Sheet3上的单元格区域A1：C4中查找含有“VBA”的单元格，并将这些单元格填充为红色。如示例中的注释所提示的，也可以使用数组，将不同的值所在的单元格标记为不同的颜色。

也可以添加下面的语句，改变单元格中文本的颜色：

.Font.ColorIndex=0

.Font.ColorIndex=myColor(I)

[示例4]为工作表中指定值的单元格填充颜色

Sub Color_cells_in_Sheet()

    Dim FirstAddress As String

    Dim MySearch As Variant

    Dim myColor As Variant

    Dim rng As Range

    Dim I As Long

    MySearch = Array("VBA")

    myColor = Array("3")

    '也能在数组中使用多个值

    'MySearch = Array("VBA", "Hello", "OK")

    'myColor = Array("3", "6", "10")

    With Sheets("Sheet4").Cells

        '将所有单元格中的填充色改为无填充色

        .Interior.ColorIndex = xlColorIndexNone

        For I = LBound(MySearch) To UBound(MySearch)

            Set rng = .Find(What:=MySearch(I), _

                            After:=.Cells(.Cells.Count), _

                            LookIn:=xlFormulas, _

                            LookAt:=xlWhole, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlNext, _

                            MatchCase:=False)

           '如果想查找rng.value的一部分,则使用参数值xlPart

           '如果使用LookIn:=xlValues,则也会处理公式单元格

            If Not rng Is Nothing Then

                FirstAddress = rng.Address

                Do

                    rng.Interior.ColorIndex = myColor(I)

                    Set rng = .FindNext(rng)

                Loop While Not rng Is Nothing And rng.Address <> FirstAddress

            End If

        Next I

    End With

End Sub

示例说明：运行程序后，将在工作表Sheet4中查找含有“VBA”的单元格，并将这些单元格填充为红色。如示例中的注释所提示的，也可以使用数组，将不同的值所在的单元格标记为不同的颜色。

也可以添加下面的语句，改变单元格中文本的颜色：

.Font.ColorIndex=0

.Font.ColorIndex=myColor(I)

[示例5]为工作簿所有工作表中含有指定值的单元格填充颜色

Sub Color_cells_in_All_Sheets()

    Dim FirstAddress As String

    Dim MySearch As Variant

    Dim myColor As Variant

    Dim sh As Worksheet

    Dim rng As Range

    Dim I As Long

    MySearch = Array("ron")

    myColor = Array("3")

   '也能在数组中使用多个值

    'MySearch = Array("VBA", "Hello", "OK")

    'myColor = Array("3", "6", "10")

    For Each sh In ActiveWorkbook.Worksheets

        With sh.Cells

             '将所有单元格中的填充色改为无填充色

            .Interior.ColorIndex = xlColorIndexNone

            For I = LBound(MySearch) To UBound(MySearch)

                Set rng = .Find(What:=MySearch(I), _

                                After:=.Cells(.Cells.Count), _

                                LookIn:=xlFormulas, _

                                LookAt:=xlWhole, _

                                SearchOrder:=xlByRows, _

                                SearchDirection:=xlNext, _

                                MatchCase:=False)

                '如果想查找rng.value的一部分,则使用参数值xlPart

                '如果使用LookIn:=xlValues,则也会处理公式单元格

                If Not rng Is Nothing Then

                    FirstAddress = rng.Address

                    Do

                        rng.Interior.ColorIndex = myColor(I)

                        Set rng = .FindNext(rng)

                    Loop While Not rng Is Nothing And rng.Address <> FirstAddress

                End If

            Next I

        End With

    Next sh

End Sub

示例说明：运行程序后，将在工作簿所有工作表中查找含有“VBA”的单元格，并将这些单元格填充为红色。如示例中的注释所提示的，也可以使用数组，将不同的值所在的单元格标记为不同的颜色。

也可以添加下面的语句，改变单元格中文本的颜色：

.Font.ColorIndex=0

.Font.ColorIndex=myColor(I)

[示例6]复制相应的值到另一个工作表中

Sub Copy_To_Another_Sheet()

    Dim FirstAddress As String

    Dim MyArr As Variant

    Dim Rng As Range

    Dim Rcount As Long

    Dim I As Long

    Application.ScreenUpdating = False

    '也能够使用含有更多值的数组

    'myArr = Array("@", "www")

    MyArr = Array("@")

    Rcount = 0

    With Sheets("Sheet5").Range("A1:E10")

        For I = LBound(MyArr) To UBound(MyArr)

            '如果使用LookIn:=xlValues,也会处理含有"@"的公式单元格

            '注意:本示例使用xlPart而不是xlWhole

            Set Rng = .Find(What:=MyArr(I), _

                            After:=.Cells(.Cells.Count), _

                            LookIn:=xlFormulas, _

                            LookAt:=xlPart, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlNext, _

                            MatchCase:=False)

            If Not Rng Is Nothing Then

                FirstAddress = Rng.Address

                Do

                    Rcount = Rcount + 1

                    '仅复制值

                    Sheets("Sheet6").Range("A" & Rcount).Value = Rng.Value

                    Set Rng = .FindNext(Rng)

                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress

            End If

        Next I

    End With

End Sub

示例说明：运行程序后，将在工作表Sheet5的单元格区域A1:E10中查找带有“@”的单元格，即e-mail地址，然后将这些单元格值依次复制到工作表Sheet6的A列中。注意，本例中使用参数值为xlPart，并且仅复制单元格值，即不带格式。

[示例7]在当前工作表的单元格区域A1:A50中输入数据5和其它的一些数据，然后在VBE编辑器中输入下面的代码。运行后，程序将在单元格A1:A50区域中查找数值5所在的单元格，并在所找到的单元格中画一个蓝色的椭圆。

Sub FindSample1()

  Dim Cell As Range, FirstAddress As String

  With Worksheets(1).Range("A1:A50")

    Set Cell = .Find(5)

    If Not Cell Is Nothing Then

       FirstAddress = Cell.Address

       Do

         With Worksheets(1).Ovals.Add(Cell.Left, _

                                      Cell.Top, Cell.Width, _

                                      Cell.Height)

                                 .Interior.Pattern = xlNone

                                 .Border.ColorIndex = 5

         End With

         Set Cell = .FindNext(Cell)

         Loop Until Cell Is Nothing Or Cell.Address = FirstAddress

    End If

  End With

End Sub

[示例8]在一个列表中复制相关数据到另一个列表

本程序的功能是，根据单元格I1中的值，在单元格区域A1:D11中的B列进行查找，每次找到相应的值，就将该单元格所在区域的行数据复制到以单元格G3(该单元格命名为found)开始的区域中。原数据如下图2所示。

图2：原始数据

点击工作表中的“查找”按钮，运行后的结果如下图3所示。

图3：运行后的结果

源程序代码清单及相关说明如下：

Option Explicit

Sub FindSample2()

  Dim ws As Worksheet

  Dim rgSearchIn As Range

  Dim rgFound As Range

  Dim sFirstFound As String

  Dim bContinue As Boolean

  ReSetFoundList '初始化要复制的列表区域

  Set ws = ThisWorkbook.Worksheets("sheet1")

  bContinue = True

  Set rgSearchIn = GetSearchRange(ws) '获取查找区域

  '设置查找参数

  Set rgFound = rgSearchIn.Find(what:=ws.Range("I1").Value, _

             LookIn:=xlValues, LookAt:=xlWhole)

  '获取第一个满足条件的单元格地址,作为结束循环的条件

  If Not rgFound Is Nothing Then sFirstFound = rgFound.Address

  Do Until rgFound Is Nothing Or Not bContinue

    CopyItem rgFound

    Set rgFound = rgSearchIn.FindNext(rgFound)

    '判断循环是否中止

    If rgFound.Address = sFirstFound Then bContinue = False

  Loop

  Set rgSearchIn = Nothing

  Set rgFound = Nothing

  Set ws = Nothing

End Sub

'获取查找区域,即B列中的"部位"单元格区域

Private Function GetSearchRange(ws As Worksheet) As Range

  Dim lLastRow As Long

  lLastRow = ws.Cells(65536, 1).End(xlUp).Row

  Set GetSearchRange = ws.Range(ws.Cells(1, 2), ws.Cells(lLastRow, 2))

End Function

'复制查找到的数据到found区域

Private Sub CopyItem(rgItem As Range)

  Dim rgDestination As Range

  Dim rgEntireItem As Range

  '获取在查找区域中的整行数据

  Set rgEntireItem = rgItem.Offset(0, -1)

  Set rgEntireItem = rgEntireItem.Resize(1, 4)

  Set rgDestination = rgItem.Parent.Range("found")

  '定位要复制到的found区域的第一行

  If IsEmpty(rgDestination.Offset(1, 0)) Then

    Set rgDestination = rgDestination.Offset(1, 0)

  Else

    Set rgDestination = rgDestination.End(xlDown).Offset(1, 0)

  End If

  '复制找到的数据到found区域

  rgEntireItem.Copy rgDestination

  Set rgDestination = Nothing

  Set rgEntireItem = Nothing

End Sub

'初始化要复制到的区域(found区域)

Private Sub ReSetFoundList()

  Dim ws As Worksheet

  Dim lLastRow As Long

  Dim rgTopLeft As Range

  Dim rgBottomRight As Range

  Set ws = ThisWorkbook.Worksheets("sheet1")

  Set rgTopLeft = ws.Range("found").Offset(1, 0)

  lLastRow = ws.Range("found").End(xlDown).Row

  Set rgBottomRight = ws.Cells(lLastRow, rgTopLeft.Offset(0, 3).Column)

  ws.Range(rgTopLeft, rgBottomRight).ClearContents

  Set rgTopLeft = Nothing

  Set rgBottomRight = Nothing

  Set ws = Nothing

End Sub

在上述程序代码中，程序FindSample2( )为主程序，首先调用子程序ReSetFoundList( )对所要复制到的数据区域初始化，即清空除标题行以外的内容；然后调用自定义函数GetSearchRange(ws As Worksheet)获取所在查找的单元格区域；在主程序中使用Find方法和FIndNext方法进行查找，调用带参数的子程序CopyItem(rgItem As Range)将查找到的单元格所在的数据行复制到相应的区域。

[示例9]实现带连续单元格区域条件的查找

下面的代码提供了一种实现以连续单元格区域中的数据为查找条件进行查找的方法和思路。在本例中，所查找条件区域为D2:D4，在单元格区域A1:A21中进行查找，将结果输入到以单元格F2开始的区域中。示例程序所对应的工作表数据及结果如下图4所示。

Sub FindGroup()

  Dim ToFind As Range, Found As Range, c As Range

  Dim FirstAddress As String

  Set ToFind = Range("D2:D4")

  With Worksheets(1).Range("a1:a21")

    Set c = .Find(ToFind(1), LookIn:=xlValues)

    If Not c Is Nothing Then

      FirstAddress = c.Address

      Do

        If c.Offset(1) = ToFind(2) And c.Offset(2) = ToFind(3) Then

          Set Found = Range(c.Offset(0, 1), c.Offset(0, 1).Offset(2))

          GoTo Exits

        End If

        Set c = .FindNext(c)

      Loop While Not c Is Nothing And c.Address <> FirstAddress

    End If

  End With

Exits:

  Found.Copy Range("F2")

End Sub

图4：数据及查找结果

[示例10]本示例所列程序将在工作簿的所有工作表中查找数值，提供了采用两种方法编写的程序，一种是Find方法，另一种是SpecialCells 方法。相对来说，使用Find方法比使用SpecialCells方法要快，当然，本示例可能不明显，但对于带大量工作表和数据的工作簿来说，这种速度差异就可以看出来了。

示例代码如下，代码中有简要的说明。

'- - -使用Find方法 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub QuickSearch()

  Dim wks As Excel.Worksheet

  Dim rCell As Excel.Range

  Dim szFirst As String

  Dim i As Long

  '设置变量决定是否加亮显示查找到的单元格

  '该变量为真时则加亮显示

  Dim bTag As Boolean

  bTag = True

  '使用input接受查找条件的输入

  Dim szLookupVal As String

  szLookupVal = InputBox("在下面的文本框中输入您想要查找的值", "查找输入框", "")

  '如果没有输入任何数据,则退出程序

  If szLookupVal = "" Then Exit Sub

   Application.ScreenUpdating = False

   Application.DisplayAlerts = False

  ' =============================================================

  ' 添加一个工作表,在该工作表中放置已查找到的单元格地址

  ' 如果该工作表存在,则先删除它

    For Each wks In ActiveWorkbook.Worksheets

      If wks.Name = "查找结果" Then

        wks.Delete

      End If

    Next wks

  ' 添加工作表

    Sheets.Add ActiveSheet

  ' 重命名所添加的工作表

    ActiveSheet.Name = "查找结果"

  ' 在新增工作表中添加标题,指明所查找的值

    With Cells(1, 1)

      .Value = "已在下面所列出的位置找到数值" & szLookupVal

      .EntireColumn.AutoFit

      .HorizontalAlignment = xlCenter

    End With

  ' =============================================================

  ' 定位到刚开始的工作表

    ActiveSheet.Next.Select

  ' =============================================================

  ' 提示您是否想高亮显示已查找到的单元格

    If MsgBox("您想加阴影高亮显示所有查找到的单元格吗?", vbYesNo, _

              "加阴影高亮显示单元格") = vbNo Then

    ' 如果不想加阴影显示单元格,则将变量bTag值设置为False

      bTag = False

    End If

  ' =============================================================

    i = 2

  ' 开始在工作簿的所有工作表中搜索

    For Each wks In ActiveWorkbook.Worksheets

  ' 检查所有的单元格,Find方法比SpecialCells方法更快

      With wks.Cells

        Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)

        If Not rCell Is Nothing Then

          szFirst = rCell.Address

          Do

           ' 添加找到的单元格地址到新工作表中

            rCell.Hyperlinks.Add Sheets("查找结果").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address

           '  检查条件判断值bTag,以决定是否加亮显示单元格

             Select Case bTag

                    Case True

                       rCell.Interior.ColorIndex = 19

             End Select

             Set rCell = .FindNext(rCell)

             i = i + 1

          Loop While Not rCell Is Nothing And rCell.Address <> szFirst

        End If

      End With

    Next wks

  ' 释放内存变量

    Set rCell = Nothing

  ' 如果没有找到匹配的值,则移除新增工作表

    If i = 2 Then

      MsgBox "您所要查找的数值{" & szLookupVal & "}在这些工作表中没有发现", , "没有匹配值"

      Sheets("查找结果").Delete

    End If

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

End Sub

'- - - 使用SpecialCells 方法- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Option Compare Text

Sub SlowerSearch()

    Dim wks As Excel.Worksheet

    Dim rCell As Excel.Range

    Dim i As Long

  '设置变量决定是否加亮显示查找到的单元格

  '该变量为真时则加亮显示

    Dim bTag As Boolean

    bTag = True

  '使用input接受查找条件的输入

    Dim szLookupVal As String

    szLookupVal = InputBox("在下面的文本框中输入您想要查找的值", "查找输入框", "")

  '如果没有输入任何数据,则退出程序

    If szLookupVal = "" Then Exit Sub

    With Application

      .ScreenUpdating = False

      .DisplayAlerts = False

      .Calculation = xlCalculationManual

  ' =============================================================

  ' 添加一个工作表,在该工作表中放置已查找到的单元格地址

  ' 如果该工作表存在,则先删除它

    For Each wks In ActiveWorkbook.Worksheets

      If wks.Name = "查找结果" Then

        wks.Delete

      End If

    Next wks

  ' 添加工作表

    Sheets.Add ActiveSheet

  ' 重命名所添加的工作表

    ActiveSheet.Name = "查找结果"

  ' 在新增工作表中添加标题,指明所查找的值

    With Cells(1, 1)

      .Value = "已在下面所列出的位置找到数值" & szLookupVal

      .EntireColumn.AutoFit

      .HorizontalAlignment = xlCenter

    End With

  ' =============================================================

  ' 定位到刚开始的工作表

    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 & "}在这些工作表中没有发现", , "没有匹配值"

    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("A1:L20")

    FindWhat = "A" '要查找的文本,可根据实际情况自定

    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, "A" <> "a")或(MatchCase:=False,"A" = "a").

'

' 不需要在模块顶指定"Option Compare Text如果指定的话,将不会正确执行大小写比较

'

' 执行单元格中的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

  EndRow = LastCell.Row

  EndCol = LastCell.Column

  If SearchOrder = xlByRows Then

    With WS

      For RowNdx = StartRow To EndRow

        For ColNdx = StartCol To EndCol

          Set Rng = .Cells(RowNdx, ColNdx)

            If MatchCase = False Then

             '''''''''''''''''''''''''''''''''''

             '如果参数MatchCase是False,则将字符串转换成大写

             '执行忽略大小写的比较

             '因此,MatchCase:=False比MatchCase:=True更慢

             '''''''''''''''''''''''''''''''''''

               If UCase(Rng.Text) Like UCase(CompareLikeString) Then

                 If FoundCells Is Nothing Then

                    Set FoundCells = Rng

                 Else

                    Set FoundCells = Application.Union(FoundCells, Rng)

                 End If

               End If

              Else

                ''''''''''''''''''''''''''''''''''''''''''''''''

                ' MatchCase为真,不需要再进行大小写转换,因此更快些

                ' 这也是不需要在模块中指定"Option Compare Text"的原因

                ''''''''''''''''''''''''''''''''''''''''''''''''

                If Rng.Text Like CompareLikeString Then

                  If FoundCells Is Nothing Then

                    Set FoundCells = Rng

                  Else

                    Set FoundCells = Application.Union(FoundCells, Rng)

                  End If

                End If

            End If

        Next ColNdx

      Next RowNdx

    End With

  Else

    With WS

      For ColNdx = StartCol To EndCol

        For RowNdx = StartRow To EndRow

          Set Rng = .Cells(RowNdx, ColNdx)

          If MatchCase = False Then

            If UCase(Rng.Text) Like UCase(CompareLikeString) Then

              If FoundCells Is Nothing Then

                Set FoundCells = Rng

              Else

                Set FoundCells = Application.Union(FoundCells, Rng)

              End If

            End If

          Else

            If Rng.Text Like CompareLikeString Then

              If FoundCells Is Nothing Then

                Set FoundCells = Rng

              Else

                Set FoundCells = Application.Union(FoundCells, Rng)

              End If

            End If

          End If

        Next RowNdx

      Next ColNdx

    End With

  End If

  If FoundCells Is Nothing Then

    Set WildCardMatchCells = Nothing

  Else

    Set WildCardMatchCells = FoundCells

  End If

End Function

使用上面代码的示例：

Sub TestWildCardMatchCells()

    Dim SearchRange As Range

    Dim FoundCells As Range

    Dim FoundCell As Range

    Dim CompareLikeString As String

    Dim SearchOrder As XlSearchOrder

    Dim MatchCase As Boolean

    Set SearchRange = Range("A1:IV65000")

    CompareLikeString = "A?C*"

    SearchOrder = xlByRows

    MatchCase = True

    Set FoundCells = WildCardMatchCells(SearchRange:=SearchRange, CompareLikeString:=CompareLikeString, _

        SearchOrder:=SearchOrder, MatchCase:=MatchCase)

    If FoundCells Is Nothing Then

        Debug.Print "没有找到!"

    Else

        For Each FoundCell In FoundCells

          Debug.Print FoundCell.Address, FoundCell.Text

        Next FoundCell

    End If

End Sub

这样，在找到所需单元格后，就可以对这些单元格进行操作了。