Excel VBA：匹配单元格颜色

Question

我有一本有两张纸的工作簿。在工作表A上，我更改了某些单元格的内部颜色。我想在工作表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

结束子

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

[真正的区别是，我让用户选择他们要匹配的单元格的颜色，仅当内部颜色匹配所选择的颜色时，我才更改内部颜色，并且更改整个行的颜色。

Answer 3

使用以下方法可以更快地完成：

Option Explicit

Sub MatchHighlight()


Dim FullListCell As Range
Dim HighlightMasterCell As Range
Dim FullList As Range
Dim HighlightMaster As Range
Dim lastRow As Range

'find last row in FullList
Set lastRow = Range("C").End(xlDown)

Set HighlightMaster = ThisWorkbook.Sheets("kleuren_medewerkers").Range("A1:A100")

Set FullList = Range(Range("C2"), ActiveSheet.Cells(lastRow.Row, 3)) 'change the number 3 to include more columns but use the lastrow of column C


For Each HighlightMasterCell In HighlightMaster 
    For Each FullListCell In FullList 
        If FullListCell .Value = HighlightMasterCell.Value Then
            FullListCell.Interior.Color= HighlightMasterCell.Interior.Color
        End If

     Next
Next

End Sub