vba – 根据date着色整行

每个星期我都会得到新的数据，然后从另一个表格中过滤出“n / a”列，然后抓取剩余的列并将它们添加到同一工作簿的现有工作表中，并且需要为date较小的行着色比明天的date，所以今天或以前。 新的数据范围每个星期都有所不同，我只想涂上新的数据。 我正在使用D列检查date，C列中也有date，所以我不知道这是否会使任务复杂化。

我知道这可以通过使用条件格式来实现，但我想使用vba代码来自动执行该过程。

我的代码将无法工作，因为它不能确定我的新数据开始的位置，只有符合条件的列D才不是整行。 请看我的代码和我的愿望结果。

Sub paste_value() Dim ws1, ws2 As Worksheet Dim lr1, lr2 As Long Dim rCell As Range 'filter Set ws1 = Worksheets("All Renewals_V2") Set ws2 = Worksheets("Renewal policies") lr1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row 'copy range from column B to column R With ws1.Range("B2", "R" & lr1) .AutoFilter Field:=1, Criteria1:="#N/A" 'paste result from column A .Copy Destination:=Cells(lr2, "A") End With For Each rCell In .Range("D5", .Cells(.Rows.Count, 4).End(xlUp)).Cells If rCell.Value <= Date + 1 Then rCell.Interior.color = vbYellow End If Next rCell End Sub 

Answer 1

如果我正确理解你的问题，我认为你的代码的下列修改将使其工作：

 Sub paste_value() 'Dim ws1, ws2 As Worksheet 'Dim lr1, lr2 As Long 'existing code declared ws1 and lr1 as Variants Dim ws1 As Worksheet, ws2 As Worksheet Dim lr1 As Long, lr2 As Long Dim rCell As Range 'filter Set ws1 = Worksheets("All Renewals_V2") Set ws2 = Worksheets("Renewal policies") 'lr1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row 'Should qualify which sheet "Rows" refers to lr1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row 'lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row 'Need to add 1 or else the first row of this week will replace the last 'row of last week lr2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'copy range from column B to column R With ws1.Range("B2", "R" & lr1) .AutoFilter Field:=1, Criteria1:="#N/A" 'paste result from column A '.Copy Destination:=Cells(lr2, "A") 'Should specify that ws2 is the sheet to which "Cells" refers .Copy Destination:=ws2.Cells(lr2, "A") End With 'I am guessing that the following statement is missing With ws2 'For Each rCell In .Range("D5", .Cells(.Rows.Count, 4).End(xlUp)).Cells 'Need to start the colouring from the first row pasted in For Each rCell In .Range("D" & lr2, .Cells(.Rows.Count, 4).End(xlUp)).Cells If rCell.Value <= Date + 1 Then 'rCell.Interior.color = vbYellow 'Change as per Scott Holtzman's comment rCell.Offset(, -3).Resize(1, 5).Interior.Color = vbYellow 'Or an alternate version would be ' rCell.EntireRow.Columns("A:E").Interior.Color = vbYellow 'Use whichever version makes the most sense to you End If Next rCell End With End Sub