查找文本并更改颜色

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

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

Answer 2

查找文本应用填充

Sub CellMarked()

  Dim rngFind As Range, rngU As Range
  Dim fndlist As Variant
  Dim strFirst As String
  Dim i As Integer, x As Integer

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

  For i = 1 To Worksheets.Count

    With Worksheets(i)

      For x = 0 To UBound(fndlist)
        ' Check if worksheet has no values.
        If Not .Cells.Find("*", .Cells(.Rows.Count, Columns.Count), -4163, 2, 1) _
            Is Nothing Then
          ' Find string.
          Set rngFind = .Cells.Find(fndlist(x), _
              .Cells(.Rows.Count, Columns.Count))
          If Not rngFind Is Nothing Then
            If Not rngU Is Nothing Then
              Set rngU = Union(rngU, rngFind) ' All other occurrences.
             Else
              Set rngU = rngFind ' First occurrence.
            End If
            strFirst = rngFind.Address
            ' Check for other occurrences.
            Do
              Set rngFind = .Cells.FindNext(rngFind)
              If rngFind.Address <> strFirst Then
                Set rngU = Union(rngU, rngFind)
               Else
                Exit Do
              End If
            Loop
          End If
        End If
      Next

      ' Apply formatting.
      If Not rngU Is Nothing Then
        rngU.Interior.Color = 255
        ' rngU.Font.Color = 255
        Set rngU = Nothing
      End If

    End With

  Next

End Sub

Answer 3

更改“strToFind”并尝试：

Option Explicit

Sub test()

    Dim strToFind As String
    Dim rng As Range, cell As Range
    Dim ws As Worksheet

    'String to Find is "Test"
    strToFind = "Test"

    With ThisWorkbook

        For Each ws In .Worksheets
            With ws
                Set rng = .UsedRange

                For Each cell In rng
                    If cell.Value = strToFind Then
                        cell.Interior.Color = RGB(255, 0, 0)
                    End If
                Next cell
            End With

        Next ws

    End With

End Sub