Найти текст и изменить цвет

Question

Я новичок, и я хотел бы просмотреть все рабочие листы рабочего журнала, выполняя это конкретное действие: изменение цвета на ячейку с определенной строкой в ​​нем.В настоящее время я использую .Replace (мне нужны MatchCase и lookat), к сожалению, он заменяет текст на искомый, безотносительно к регистру Che, поэтому он распределяет строку по цепочке (например, если в массиве это строчные буквы и строка будетнайден в верхнем регистре, он будет изменен на строчные).Единственный способ обойти это - использовать 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

Измените "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

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

вы можете использовать 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