跪求各位大哥大姐大神给予解决！

work_01

各位大神请下载附件帮忙看下，如果哪里有描述不清楚的，请告诉小弟，让小弟给各位大哥大姐解释！

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, i&, j&, p&, n&
   
    Application.ScreenUpdating = False
   
    With [A1].CurrentRegion.Offset(, 1)
        ar = .Value
        .Interior.Color = xlNone
        For i = 2 To UBound(ar)
            p = 1: n = 2
            For j = 1 To UBound(ar, 2) - 1
                If ar(i, j + 1) <> ar(i, p) Then
                    If j - p > 0 Then
                         n = n + 1
                         Range(.Cells(i, p), .Cells(i, j)).Interior.ColorIndex = n
                    End If
                    p = j + 1
                End If
               
            Next j
        Next i
    End With
        
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

work_01

感谢楼上的两位！