Excel VBA: Match Cell Color

Question

У меня есть книга с двумя листами. На листе А я изменил цвет интерьера некоторых ячеек. Я хотел бы найти ячейки в Листе B с соответствующим текстом и установить их на тот же цвет интерьера. Тем не менее, когда я добираюсь до hRow = Application..., я получаю сообщение об ошибке The application does not support this object or property. Я искал аналогичные функции, но у меня нет никакого успеха, чтобы найти подходящий способ сопоставить текст, не перебирая каждую ячейку в диапазоне.

Public Sub MatchHighlight() 

Dim lRow As Integer 
Dim i As Integer 
Dim hRow As Integer 

Dim LookUpRange As Range 
Set LookUpRange = Worksheets("HR - Highlight").Range("C2:C104") 

Dim compare As Range 
Set compare = Worksheets("Full List").Range("C2:C277") 

lRow = Worksheets("Full List").UsedRange.Rows.Count 

For i = 2 To lRow 

    hRow = Application.Worksheets("Full List").WorksheetFunction.Match(compare.Range("C" & i).Text, LookUpRange, 0) 

    If Not IsNull(hRow) Then 

     compare.Range("C" & i).Interior.Color = LookUpRange.Range("C" & hRow).Interior.Color 

    End If 

Next i 

End Sub

Answer 1

Sub MatchHighlight() 

    Dim wsHighlight As Worksheet 
    Dim wsData As Worksheet 
    Dim rngColor As Range 
    Dim rngFound As Range 
    Dim KeywordCell As Range 
    Dim strFirst As String 

    Set wsHighlight = Sheets("HR - Highlight") 
    Set wsData = Sheets("Full List") 

    With wsData.Columns("C") 
     For Each KeywordCell In wsHighlight.Range("C2", wsHighlight.Cells(Rows.Count, "C").End(xlUp)).Cells 
      Set rngFound = .Find(KeywordCell.Text, .Cells(.Cells.Count), xlValues, xlWhole) 
      If Not rngFound Is Nothing Then 
       strFirst = rngFound.Address 
       Set rngColor = rngFound 
       Do 
        Set rngColor = Union(rngColor, rngFound) 
        Set rngFound = .Find(KeywordCell.Text, rngFound, xlValues, xlWhole) 
       Loop While rngFound.Address <> strFirst 
       rngColor.Interior.Color = KeywordCell.Interior.Color 
      End If 
     Next KeywordCell 
    End With 

End Sub 

Answer 2

Чтобы получить именно то, что я хотел, я использовал код @ tigeravatar в качестве основы и в конечном итоге со следующим:

Sub MatchHighlight() 

Dim wsHighlight As Worksheet 
Dim wsData As Worksheet 
Dim rngColor As Range 
Dim rngFound As Range 
Dim KeywordCell As Range 
Dim strFirst As String 
Dim rngPicked As Range 

Set rngPicked = Application.InputBox("Select Cell", Type:=8) 
Set wsHighlight = Sheets("HR - Highlight") 
Set wsData = Sheets("Full List") 

With wsData.Columns("C") 
    For Each KeywordCell In wsHighlight.Range("C2", wsHighlight.Cells(Rows.Count, "C").End(xlUp)).Cells 
     Set rngFound = .Find(KeywordCell.Text, .Cells(.Cells.Count), xlValues, xlWhole) 
     If Not rngFound Is Nothing Then 
      strFirst = rngFound.Address 
      Set rngColor = rngFound 
      Do 
       Set rngColor = Union(rngColor, rngFound) 
       Set rngFound = .Find(KeywordCell.Text, rngFound, xlValues, xlWhole) 
      Loop While rngFound.Address <> strFirst 

      Set rngColor = rngColor.Offset(0, -2).Resize(1, 3) 

      If KeywordCell.Interior.Color = rngPicked.Interior.Color Then 
       rngColor.Interior.Color = KeywordCell.Interior.Color 
      End If 
     End If 
    Next KeywordCell 
End With 

End Sub 

Только реальные различия в том, что Я позволяю пользователю выбирать цвет клеток, которые они пытаются сопоставить, я меняю цвет интерьера только тогда, когда он соответствует выбранному цвету, и я меняю цвет всей строки.