VBA 查找的小老弟替换...

Range.Find(What,[After],[LookIn],[LookAt],[SearchOrder],[SearchDirection],[MatchCase],[MatchByte],[SearchFormat])

单元格.Find (查找值,[开始位置],[查找范围类型],[匹配模式],[查找方式行或者列],[查找方向前或者后],[是否大小写],[全角或半角],[查找格式])

Range.Find(What查找值,Lookat匹配模式)

Range.Replace (What,Replacement,[LookAt],[SearchOrder],[MatchCase],[MatchByte],[SearchFormat],[ReplaceFormat])

Range.Replace(查找值,替换值,匹配模式,查找方式,是否大小写,全角半角,按格式搜索,按格式替换)

Option Explicit
Dim FindCell As Range, ReplaceCell As Range


Private Sub UserForm_Initialize() '初始化窗体
    Dim intX&
    Dim aRes(1 To 56)
    For intX = 1 To 56
        aRes(intX) = intX
    Next
    With Me
        With .颜色
            .Font.Size = 11
            .List = aRes
            .ListIndex = 2
        End With
        .查找.Value = True
        .完整.Value = True
        .查找格式.TextAlign = 1
        .替换格式.TextAlign = 1
        .查找格式.Text = "无"
        .替换格式.Text = "无"
        Set FindCell = Nothing
        Set ReplaceCell = Nothing
    End With
End Sub


Private Sub 查找颜色_Click()
    Set FindCell = Application.InputBox("从单元格选择颜色格式", "选择指定查找颜色", , , , , , 8)
    With Me.查找格式
        .BackColor = ColorToRGB(FindCell(1))
        .Text = "预览"
    End With
End Sub


Private Sub 区域选择_Click() '区域选择
    Dim Rng As Range
    Set Rng = Application.InputBox("数据来源", "请选择区域!!", ActiveCell.Address, , , , , 8)
    If Rng Is Nothing Then Exit Sub
    Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
    Me.区域.Value = Rng.Address
End Sub


Private Sub 替换颜色_Click()
    Set ReplaceCell = Application.InputBox("从单元格选择颜色格式", "选择指定查找颜色", , , , , , 8)
    With Me.替换格式
        .BackColor = ColorToRGB(ReplaceCell(1))
        .Text = "预览"
    End With
End Sub


Private Sub 执行_Click()
    If Me.查找.Value Then
        Call Find_Value
    ElseIf Me.替换.Value Then
        Call Replace_Value
    End If
End Sub


Sub Find_Value()
    Dim Rng As Range, Cell As Range, RngData As Range
    Dim strAddress$, strVal, strMatch$
    On Error Resume Next
    If Me.区域.Text = "" Then Exit Sub
    Set RngData = Range(Me.区域.Text)
    strVal = Trim(Me.查找内容.Text)
    strMatch = IIf(Me.完整.Value, xlWhole, xlPart) '匹配模式
    With RngData
        If Len(strVal) Then
            .Interior.ColorIndex = 0 '初始化背景色
            Set Cell = .Find(What:=strVal, LookIn:=xlValues, LookAt:=strMatch)
            If Cell Is Nothing Then MsgBox "[" & RngData.Address & "]区域中并无" & strVal, 64: Exit Sub
            strAddress = Cell.Address '记录第一个单元格地址
            Do
                If Rng Is Nothing Then
                    Set Rng = Cell '初始化
                Else
                    Set Rng = Union(Rng, Cell) '合并
                End If
                    Set Cell = .FindNext(Cell) '查找下一个
            Loop Until Cell.Address = strAddress
            Rng.Interior.ColorIndex = Me.颜色.Text '标记背景颜色
            Me.标记.Caption = "总共找到了" & Rng.Count & "个<<" & strVal & ">>" '写入找到多少个
        ElseIf Not FindCell Is Nothing Then
            Application.FindFormat.Clear '清除原有格式
            With Application.FindFormat '设置格式
                .Font.Name = FindCell.Name '查找字体
                .Font.Bold = FindCell.Font.Bold '是否粗体
                .Interior.ColorIndex = FindCell.Interior.ColorIndex '查找背景色
            End With
            Set Cell = .Find(What:="", LookIn:=xlFormulas, LookAt:=strMatch, SearchFormat:=True)
            If Cell Is Nothing Then MsgBox "[" & RngData.Address & "]区域中并无" & strVal, 64: Exit Sub
            strAddress = Cell.Address
            Do
                If Rng Is Nothing Then
                    Set Rng = Cell '初始化
                Else
                    Set Rng = Union(Rng, Cell) '合并
                End If
                    Set Cell = .Find(What:="", After:=Cell, SearchFormat:=True) '查找下一个
            Loop Until Cell.Address = strAddress
            Rng.Select '选中
            Me.标记.Caption = "总共找到了" & Rng.Count & "个相同的格式" '写入找到多少个
        Else
            MsgBox "请输入查找内容", 64, "出错"
        End If
    End With
End Sub


Sub Replace_Value()
    Dim RngData As Range
    Dim strVal, strMatch$
    If Me.区域.Text = "" Then Exit Sub
    Set RngData = Range(Me.区域.Text)
    strVal = Trim(Me.查找内容.Text)
    If Len(strVal) Then
        With RngData
            strMatch = IIf(Me.完整.Value, xlWhole, xlPart) '匹配模式
            .Replace What:=strVal, replacement:=Trim(Me.替换内容.Text), LookAt:=strMatch
        End With
    ElseIf Not ReplaceCell Is Nothing Then
        With Application
            .FindFormat.Clear '清除原有查找格式
            .ReplaceFormat.Clear '清除原有替换格式
            With .FindFormat '设置查找格式
                .Font.Size = FindCell.Font.Size
                .Font.ColorIndex = FindCell.Font.ColorIndex
                .Font.Name = FindCell.Font.Name
                .Interior.ColorIndex = FindCell.Interior.ColorIndex
            End With
            With .ReplaceFormat '设置替换格式
                .Font.Size = ReplaceCell.Font.Size
                .Font.ColorIndex = ReplaceCell.Font.ColorIndex
                .Font.Name = ReplaceCell.Font.Name
                .Interior.ColorIndex = ReplaceCell.Interior.ColorIndex
            End With
        End With
        RngData.Replace What:="", replacement:="", LookAt:=xlPart, SearchFormat:=True, ReplaceFormat:=True
    Else
         MsgBox "请输入查找内容", 64, "出错"
    End If
End Sub


Function ColorToRGB(Rng As Range) '转换RGB
    Dim M&, R&, G&, B&
    M = Rng.Interior.Color
    R = M Mod 256
    G = M \ 256 Mod 256
    B = M \ 256 ^ 2 Mod 26
    ColorToRGB = RGB(R, G, B)
End Function

.Replace What:=strVal, replacement:=Trim(Me.替换内容.Text), LookAt:=strMatch

Rng.Interior.ColorIndex = Me.颜色.Text 

Rng=指定值