关于查找方法(Find方法)的应用示例补充

关于查找方法(Find方法)的应用示例补充(续)
分类:ExcelVBA>>ExcelVBA对象模型编程>>常用对象>>Range对象
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

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