excel - 查找文本并更改颜色

Question

我想循环工作簿的所有工作表，以更改其中包含特定字符串的单元格的颜色。

我使用.Replace（我需要 MatchCase 和lookat）。
它在不考虑大小写的情况下替换文本。（例如，如果在数组中它是小写的并且找到的字符串是大写的，它将被更改为小写）。绕过这一点的唯一方法是使用MatchCase:= false并列出所有选项，这可能非常低效。

我可以使用.Find或其他功能执行操作吗？

Sub CellMarked()

Dim fndlist As Variant, x As Integer, sht as worksheet

fndlist = Array("Column1", "Column2")

For Each sht In ActiveWorkbook.Worksheets
    With sht
        For x = LBound(fndlist) To UBound(fndlist)
            .Cells.Replace What:=fndlist(x), Replacement:=fndlist(x), _
              lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
              SearchFormat:=False, ReplaceFormat:=True
            Application.ReplaceFormat.Font.Color = 255
        Next x
    End With
next sht
    
End Sub

标签： excelvba

Answer 1

您可以使用Find()方法并构建一个辅助函数：

Function GetCellsWithValue(sht As Worksheet, val As Variant, foundCells As Range) As Boolean
    Dim found As Range
    Dim firstAddress As String
    With sht.UsedRange
        Set foundCells = .Resize(1, 1).Offset(.Rows.Count) ' fill foundCells with a "dummy" found one to avoid 'If Not foundCells Is Nothing' check before any 'Union()' method call

        Set found = .Find(what:=val, lookat:=xlPart, LookIn:=xlValues)
        If Not found Is Nothing Then
            firstAddress = found.Address
            Do
                Set foundCells = Union(foundCells, found)
                Set found = .FindNext(found)
            Loop While found.Address <> firstAddress
        End If

        Set foundCells = Intersect(.Cells, foundCells) ' get rid of the "dummy" found cell
    End With

    GetCellsWithValue = Not foundCells Is Nothing
End Function

您可以在“主要”子中使用如下：

Option Explicit

Sub CellMarked()

    Dim fndlist As Variant, val As Variant, sht As Worksheet
    Dim foundCells As Range

    fndlist = Array("Column1", "Column2")

    For Each sht In ActiveWorkbook.Worksheets
    With sht
        For Each val In fndlist
            If GetCellsWithValue(sht, val, foundCells) Then foundCells.Font.Color = 255
        Next
    End With
    Next sht

End Sub