'項目の値によって交互に行の色を変えるマクロ

'色を設定したいセル範囲を選択し、MySwitchRowColorマクロを
'実行してください。

Option Explicit

Sub MySwitchRowColor()
    Const myTitle As String = "基準値による書式の設定"
    Dim formatNo As Integer, formatCount As Integer
    Dim range1 As Range, range2 As Range
    Dim r As Range, r2 As Range
    Dim v As Variant, v0() As Variant
    Dim i As Long, j As Long, k As Long, n As Long
    Dim ifBreak As Boolean

    formatCount = 2
    formatNo = 1    '下限は必ず1

    If TypeName(Selection) <> "Range" Then Exit Sub
    If Selection.Cells.Count = 1 Then
        Selection.CurrentRegion.Select
    Else
        Set range1 = Application.Intersect( _
            ActiveSheet.UsedRange, Selection.Areas(1))
        If range1 Is Nothing Then Exit Sub
        range1.Select
    End If

    On Error Resume Next
    Set range2 = Application.InputBox( _
        prompt:="基準とする列のセルを選択してください。", _
        Title:=myTitle, Type:=8)
    On Error GoTo 0
    If range2 Is Nothing Then Exit Sub
    Set range2 = range2.EntireColumn

    Set r = Application.Intersect(Selection.Rows(1), range2)
    If r Is Nothing Then
        MsgBox "選択列が対象範囲にありません。", vbExclamation, myTitle
        Exit Sub
    End If

    ReDim v0(1 To r.Cells.Count)
    k = 1
    For Each r2 In r.Cells
        v0(k) = r2.Value
        k = k + 1
    Next

    n = Selection.Rows.Count
    j = 1

    For i = 2 To n
        Set r = Selection.Rows(i)
        ifBreak = False
        k = 1
        For Each r2 In Application.Intersect(r, range2).Cells
            v = r2.Value
            If (v <> v0(k)) Or ifBreak Then
                ifBreak = True
                v0(k) = v
            End If
            k = k + 1
        Next
        If ifBreak Then
            SetFormat r.Offset(-1 * j).Resize(j), formatNo
            If formatNo < formatCount Then
                formatNo = formatNo + 1
            Else
                formatNo = 1
            End If
            j = 1
        Else
            j = j + 1
        End If
    Next
    SetFormat Selection.Rows(n).Offset(-1 * j + 1).Resize(j), formatNo
End Sub

'書式変更マクロ
'MySwitchRowColor()の中で使っています。
'設定内容はお好みで変更してください。

Sub SetFormat(range1 As Range, index1 As Integer)
    Select Case index1
        Case 1
            With range1.Interior
                '色の設定（無色）
                .ColorIndex = xlNone
            End With
        Case Else
            With range1.Interior
                '色の設定
                .ColorIndex = 24
                .Pattern = xlSolid
            End With
    End Select
End Sub