Compare ells A3 and A2, if equal, nothing else color row 3 cells A though F. Repeat with next row

问题

What I have are a list of contracts below a header row. Some contracts take up multiple rows.

What I would like is to have a VBA Macro that will compare cell A3 to A2. If they are the same; next. If they are different, then select the cells A3:F3 and change Interior.Color to grey.

Then compare A4 to A3, then A5 to A4 and repeat for all used cells in the A column, effectively making a table.

This is what the screen looks like:

Row   Column A   Column B     C         D        E        F

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)

What I would like to see is:

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

I have spent my day searching and have found (and worked on the following script however it is only coloring the first cell in the line.

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

I feel that it will just be a modification of the line: a.Interior.color = currentColor 'Interior.Color but I just can't see the solution.

Suggestions?

回答1:

if you are interested, this can be done with conditional formatting with the following formula:

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

If you really want to use vba then change the this line:

a.Interior.color = currentColor 'Interior.Color

to:

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

so it will apply to the entire row in the desired range and not just Column A.

来源：https://stackoverflow.com/questions/44169577/compare-ells-a3-and-a2-if-equal-nothing-else-color-row-3-cells-a-though-f-rep

标签

excel

vba

excel-vba

if-statement

compare