比较ells A3和A2（如果相等），没有其他颜色的行3单元格A到F.重复下一行

我所拥有的是标题行下方的合同列表。 有些合约占用多行。

我想要的是有一个VBAmacros将比较单元格A3到A2。 如果他们是一样的; 下一个。 如果它们不同，则select单元格A3：F3并将Interior.Color更改为灰色。

然后比较A4到A3，然后A5到A4，并在A列中重复使用所有使用的单元格，从而有效地创build一个表格。

这就是屏​​幕的样子：

Row Column A Column BCDEF 1. 000000 (Info) (Info) (Info) (Info) (Info) 2. 111111 (Info) (Info) (Info) (Info) (Info) 3. 123456 (Info) (Info) (Info) (Info) (Info) 4. 123456 (Info) (Info) (Info) (Info) (Info) 5. 654321 (Info) (Info) (Info) (Info) (Info) 6. 124536 (Info) (Info) (Info) (Info) (Info) 7. 666666 (Info) (Info) (Info) (Info) (Info) 

我想看到的是：

 1. 000000 (Info) (Info) (Info) (Info) (Info) 'line is clear 2. 111111 (Info) (Info) (Info) (Info) (Info) 'line is grey 3. 123456 (Info) (Info) (Info) (Info) (Info) 'line is clear 4. 123456 (Info) (Info) (Info) (Info) (Info) 'line is clear 5. 654321 (Info) (Info) (Info) (Info) (Info) 'line is grey 6. 124536 (Info) (Info) (Info) (Info) (Info) 'line is clear 7. 666666 (Info) (Info) (Info) (Info) (Info) 'line is grey 

我花了我的一天search，并find（并在以下脚本的工作，但它只是着色行中的第一个单元格。

 Sub Line_Shading() Application.ScreenUpdating = False Dim this As Variant Dim previous As Variant Dim currentColor As Long Dim rng As Range Dim a As Range ' pick a color to start with currentColor = 14277081 ' 14277081 Grey or 16777215 Clear ' rng = used and visible cells Set rng = Range("A2:A" & Range("A2").End(xlDown).Row) For Each a In rng If Not a.Row = 1 Then ' skip header row this = a.Value 'some simple test logic to switch colors If this <> previous Then If currentColor = 14277081 Then currentColor = 16777215 ElseIf currentColor = 16777215 Then currentColor = 14277081 End If End If 'set interior color a.Interior.color = currentColor 'Interior.Color previous = this End If Next a Application.ScreenUpdating = True End Sub 

我觉得这只是对行的修改：a.Interior.color = currentColor'Interior.Color，但我只是看不到解决scheme。

build议？

Answer 1

如果您有兴趣，可以使用以下公式的条件格式来完成此操作：

 =ISEVEN(SUMPRODUCT(1/COUNTIFS($A$1:$A1,$A$1:$A1))) 

---

如果你真的想用vba，那么改变这一行：

 a.Interior.color = currentColor 'Interior.Color 

至：

 Range(Cells(a.Row, 1), Cells(a.Row, 6)).Interior.Color = currentColor 'Interior.Color 

所以它将适用于所需范围内的整个行，而不仅仅是A列。