2

我有一个有两张纸的工作簿。在工作表 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

结束子

4

3 回答 3

3 
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
于 2013-09-18T16:00:25.983 回答
1

为了得到我想要的，我使用@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

唯一真正的区别是我让用户选择他们尝试匹配的单元格的颜色，我只在与选择的颜色匹配时更改内部颜色，然后更改整行的颜色。

于 2013-09-18T18:23:51.980 回答
0

这可以通过以下方式更快地完成：

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
于 2020-04-17T07:23:01.550 回答