基于另一张纸上的值（日期）的颜色单元格

Question

我在工作表 2 的 D 列上有几个日期。我想搜索工作表 1 的第一行，如果找到相同的日期，则为单元格着色，但似乎无法正常工作。 我相信问题出在范围内，但尝试了几种方法但没有任何效果。

请在下面查看我的代码：

Sub test2()

Dim xcel As Range
Dim ycel As Range
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim lc As Long
Dim lr As Long

Set WS1 = ThisWorkbook.Worksheets("sheet1")
Set WS2 = ThisWorkbook.Worksheets("sheet2")


lc = WS1.Cells(1, Columns.Count).End(xlToLeft).Column
lr = WS2.Range("D" & Rows.Count).End(xlUp).Row

With WS1
    For Each xcel In .Range(Cells(1, 1), Cells(1, lc))
        For Each ycel In WS2.Range(Cells(2, 4), Cells(lr, 4))
            If xcel.Value = ycel.Value Then
                xcel.Interior.ColorIndex = 6
                xcel.Font.ColorIndex = 1
            End If
        Next ycel
    Next xcel
End With
End Sub

先感谢您

Answer 1

请测试下一个方法。 它使用两个 arrays，用于更快地迭代每个单元格之间的迭代，并为匹配的单元格创建一个Union范围，该范围将在末尾立即着色：

Sub test2ColorCellInt()
 Dim WS1 As Worksheet, arr1, WS2 As Worksheet, arr2
 Dim lc As Long, lr As Long, i As Long, j As Long, rngCol As Range

 Set WS1 = ThisWorkbook.Worksheets("sheet1")
 Set WS2 = ThisWorkbook.Worksheets("sheet2")


 lc = WS1.cells(1, Columns.count).End(xlToLeft).Column
 lr = WS2.Range("D" & rows.count).End(xlUp).row
 arr1 = WS1.Range(WS1.cells(1, 1), WS1.cells(1, lc)).value 'place the range in an array for faster iteration
 arr2 = WS2.Range(WS2.cells(2, 4), WS2.cells(lr, 4)).value 'place the range in an array for faster iteration

 For i = 1 To UBound(arr1, 2) 'iterate on columns of arr1:
    For j = 1 To UBound(arr2) 'iterate between rows of arr2:
        If arr1(1, i) = arr2(j, 1) Then 'in case of a match:
            If rngCol Is Nothing Then   'if the range to keep the matching cells is nothing
                Set rngCol = WS1.cells(1, i) 'create the range
            Else
                Set rngCol = Union(rngCol, WS1.cells(1, i)) 'make a Union between existing and the matching cell
            End If
        End If
    Next j
 Next i
 If Not rngCol Is Nothing Then 'if the range exists, do the job:
    rngCol.Interior.ColorIndex = 6
    rngCol.Font.ColorIndex = 1
 End If
End Sub

初步清除第一行现有单元格的格式可能会很好，以便在下次运行代码时查看差异，但如果没有要求，我没有包括这样的方法......

您现有的代码错误地限定了使用的范围，使用活动工作表的相同cells来构建它们。 但我试图提供一种更快的方法来处理这个问题。