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

gwjkkkkk

参与一下。。。

class11class

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

调试后全部是黄色的

class11class

longwin 发表于 2024-6-7 15:12
参与一下：
Sub test()
    l = [A1].End(4).Row

调试后:AB03  只是一条上了绿色,AB03组件没有全部上绿色

class11class

gwjkkkkk 发表于 2024-6-7 21:32
Option Explicit
Sub TEST1()
    Dim ar, br, i&, p&, m&, n&

代码写点有bug

class11class

class11class 发表于 2024-6-8 14:51
代码写点有bug

是不是我的提问题有bug,间隔批量上色,用两种颜色,黄白就好解决,黄白绿,就太难了,m mod 4

准提部林

上色//
Sub Test_A1() 'by.准提部林
Dim Arr, i&, R&, N&, k%
Arr = Range([a1], [a65536].End(3)(2))
For i = 2 To UBound(Arr) - 1
    If Arr(i, 1) <> Arr(i - 1, 1) Then R = i: N = 0
    N = N + 1
    If Arr(i, 1) <> Arr(i + 1, 1) Then
       k = (k + 1) Mod 4
       Cells(R, 1).Resize(N).Interior.ColorIndex = Array(0, 6, 0, 43)(k)
    End If
Next i
End Sub

EHGOOD

三种颜色上色不难，有个bug是，你的文字描述是黄-空白-绿循环，示例实际是黄-空白-绿-空白循环。

class11class

gwjkkkkk 发表于 2024-6-7 21:32
Option Explicit
Sub TEST1()
    Dim ar, br, i&, p&, m&, n&

n = n + 1
  k = n Mod 4     修改成这样,放到if里面,就成了

gwjkkkkk

class11class 发表于 2024-6-8 14:51
代码写点有bug

用黄白绿三种颜色循环也是可以实现，我是按照你示例黄-空白-绿-空白来循环。

usedrange

参与学习

1. Sub t()
   
2.     Dim m%, wb, k, n%, b, color, a%
   
3.     m = [a1].End(4).Row
   
4.     Set wb = ActiveSheet.Range("a2:a" & m)
   
5.     n = 1: a = 1: color = 6: b = [a2]
   
6.     For Each k In wb
   
7.         If n Mod 2 <> 0 Then
   
8.             If k <> b Then
   
9.                 b = k: n = n + 1
   
10.                 If a Mod 2 <> 0 Then
    
11.                     color = 4
    
12.                 Else
    
13.                     color = 6
    
14.                 End If
    
15.                 a = a + 1
    
16.             Else
    
17.                 k.Interior.ColorIndex = color
    
18.             End If
    
19.         Else
    
20.             If b <> k Then b = k: n = n + 1: k.Interior.ColorIndex = color
    
21.         End If
    
22.     Next k
    
23. End Sub

复制代码