-Sub 罗列表中三省员工的姓名() 'Find循环法，通用于Excel 2002 2003 2007和2010

  Dim rng As Range, RngTemp As Range, firstAddress As String  '声明需要使用的变量

  Dim i As Byte, FindCell As Range, ShtName As String, sht As Worksheet

  '将待查找的目标区域C2到C列最后一个非空单元格赋予对象变量

  Set rng = Range([c2], Cells(Rows.Count, "C").End(xlUp))

   '将四川省、湖南省和湖北省转换成数组，然后循环数组每个元素。数组的基数默认为0，所以从0递增

  For i = 0 To UBound(Array("四川省", "湖南省", "湖北省"))  '本例中数组的上限为2，但为了提升程序的通用性，利用UBound计算而不是手工指定

    '开始查找数据，按值精确查找，不区分大小写

    Set RngTemp = rng.Find(What:=Array("四川省", "湖南省", "湖北省")(i), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)

    If Not RngTemp Is Nothing Then  '如果变量RngTemp不再是Nothing,即找到目标值

      firstAddress = RngTemp.Address  '记录第一个目标的地址

      Do  '只要找到的单元格的地址不等于刚才记录的地址就一直循环下去

        '如果变量FindCell未初始化则将查找结果赋予它，否则合并该变量与查到的单元格

        If FindCell Is Nothing Then Set FindCell = RngTemp Else Set FindCell = Union(FindCell, RngTemp)

        Set RngTemp = rng.FindNext(RngTemp)  '查找下一个

      Loop While RngTemp.Address <> firstAddress

    End If

  Next i

  '如果变量FindCell已初始化，就选择所有目标的整列，否则提示并退出程序

  If Not FindCell Is Nothing Then FindCell.EntireRow.Select Else MsgBox "没有符合条件的数据": Exit Sub

  On Error Resume Next  '防错，有错误时继续下一步

  ShtName = ActiveSheet.Name  '记录当前表的名称

  Set sht = Sheets("查询结果")  '将工作表“查询结果”赋予变量sht。目的是判断有没有这个工作表

  If Err.Number <> 0 Then  '如果出错,则表示不存在“查询结果”工作表

    Sheets.Add After:=Sheets(Sheets.Count)  '在最末尾创建一个工作表

    Sheets(Sheets.Count).Name = "查询结果"  '将新表命名为“查询结果”

  Else  '否测，清空“查询结果”原有数据

    Sheets(Sheets.Count).Cells.Clear

  End If

  Sheets(ShtName).Select  '返回刚才查找的工作表

  Selection.Copy Sheets(Sheets.Count).[a1]  '将选择的所有对象复制到“查询结果”表中

End Sub-

-Sub 按格式查找()

  Dim FindStr As String, Rng As Range, mRng As Range

  Application.FindFormat.Clear '清除原有格式

  With Application.FindFormat '设置查找格式

    .Font.Name = "Arial Black" '指定字体

    .Font.Bold = True          '加粗

    .Interior.Color = 65535    '黄色背景

  End With

  With Range("C:C") '在C列查找

    Set Rng = .Find(What:="", LookIn:=xlFormulas, LookAt:=xlPart, SearchFormat:=True) '按格式查找

    If Rng Is Nothing Then MsgBox "没有找到此类单元格": Exit Sub '如果找不到则退出

    Set mRng = Rng '将找到的对象赋予另一个变量

    FindStr = Rng.Address '取第一个找到的单元格的地址

     Do

        Set mRng = Union(mRng, Rng) '合并变量mrng和找到的单元格(如果有多个符合条件,则逐一合并)

        Set Rng = .Find(What:="", After:=Rng, SearchFormat:=True) '查找下一个

     Loop While FindStr <> Rng.Address  '直到找到的单元格的地址等于一个单元格地址时停止

      mRng.Select '选择所有符合条件的单元格

    End With

End Sub-