查找文字并更改颜色

Question

我是新手，我想循环执行woorkbook的所有工作表，以执行此特定操作：将颜色更改为带有特定字符串的单元格。 我当前正在使用.Replace（我需要MatchCase并进行查找），不幸的是，它用搜索到的文本替换了文本，而不考虑che Case，因此它将字符串链接起来（例如，如果数组中的小写字母，则字符串是如果是大写字母，则会更改为小写）。绕过此操作的唯一方法是使用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