如何实现批量组件间隔上色?

class11class

请大佬帮忙解决下这个问题:

zpy2

https://club.excelhome.net/forum.php?mod=viewthread&tid=1683649&mobile&_dsign=f4575def

zhangcheng6688

学习一下数组
Sub test()
arr = [a1].CurrentRegion
r = 2
n = 1
On Error Resume Next
For i = 2 To UBound(arr)
   If arr(i, 1) <> arr(i + 1, 1) Then
      If n = 1 Then
         For j = r To i
            Cells(j, 1).Interior.Color = vbYellow
         Next
         n = n + 1
         r = i + 1
      ElseIf n = 2 Then
         For j = r To i
            Cells(j, 1).Interior.Color = vbWhite
         Next
         n = n + 1
         r = i + 1
      Else
          For j = r To i
            Cells(j, 1).Interior.Color = RGB(146, 208, 80)
         Next
         n = n + 1
         r = i + 1
      End If
   End If
   If n = 4 Then
      n = 1
   End If
Next
End Sub

LIUZHU

参与下，效果展示

LIUZHU

JSA代码

1. function 填充(){
   
2.         const st=new Set();
   
3.         [...Range("a2:a21")].forEach(function(rng){
   
4.                 st.add(rng.Value2);
   
5.                 rng.Interior.ColorIndex=this[st.size % 3];
   
6.         },{"1":6,"2":-4142,"0":43});
   
7. }

复制代码

LIUZHU

附件，适合WPS测试

半百

zhangcheng6688

半百 发表于 2024-6-7 14:26

向老师学习一下，自己写得太复杂了

longwin

参与一下：
Sub test()
    l = [A1].End(4).Row
    s = Cells(2, 1):    ys = 1
    For i = 2 To l
        If Cells(i, 1) <> s Then
            ys = ys + 1
            s = Cells(i, 1)
        End If
        If ys = 1 Then Cells(i, 1).Interior.Color = RGB(255, 255, 0)
        If ys = 3 Then Cells(i, 1).Interior.Color = RGB(0, 255, 0):             ys = 0
    Next
End Sub

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, p&, m&, n&
   
    br = Array(65535, 16777215, 5296274, 65535)
    With [A1].CurrentRegion.Offset(1)
        .Interior.Color = xlNone
        ar = .Value: p = 1
        For i = 1 To UBound(ar) - 1
            If ar(i + 1, 1) <> ar(p, 1) Then
                n = n + 1
                m = IIf(n Mod 4 = 0, 1, n Mod 4)
                Range(.Cells(p, 1), .Cells(i, 1)).Interior.Color = br(m - 1)
                p = i + 1
            End If
        Next i
    End With
    Beep
End Sub