­ã´£³¡ªL

Sub TEST_A1()
Dim xR As Range, xH As Range, Cr, x%
Cr = Array(44, 37, 39, 43) '¦â¸¹¥Î"¿ý»s"§Y¥i¨ú±o
With Range([f2], [a65536].End(3))
     .Interior.ColorIndex = xlNone
     Application.ScreenUpdating = False
     For Each xR In .Columns(4).Cells
         If xR <> xR(0) Then Set xH = xR(1, 0)
         If xR <> xR(2) Then
            Range(xH, xR).Interior.ColorIndex = Cr(x)
            x = x + 1: If x = 4 Then x = 0
         End If
     Next
End With
End Sub

­ã´£³¡ªL

¤W¤@­Ó¬O"³v¦æ"¶ñ¦â, ¸ûºC//
³o­Ó¬O"¤À°Ï"¶ñ¦â, ·í¸ê®Æ¸û¦h®É, ²z½×¤W·|¸û§Ö!!!
Sub TEST_A2()
Dim Arr, i&, R&, N&, S$, T$, x%, xA As Range, U(1 To 4) As Range
Cr = Array(0, 44, 37, 39, 43)
With Range([f2], [a65536].End(3)(2))
     .Interior.ColorIndex = xlNone
     Arr = .Value
End With
For i = 1 To UBound(Arr) - 1
    S = Arr(i, 4)
    If S <> T Then T = S: R = i + 1: N = 0
    N = N + 1
    If S <> Arr(i + 1, 4) Then
       x = x Mod 4 + 1: Set xA = Cells(R, "c").Resize(N, 2)
       If U(x) Is Nothing Then Set U(x) = xA Else Set U(x) = Union(U(x), xA)
       If U(x).Count > 100 Then U(x).Interior.ColorIndex = Cr(x): Set U(x) = Nothing
    End If
Next i
For x = 1 To 4
    If Not U(x) Is Nothing Then U(x).Interior.ColorIndex = Cr(x)
Next x
End Sub