基於另一張紙上的值（日期）的顏色單元格

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來構建它們。 但我試圖提供一種更快的方法來處理這個問題。