隔编码分颜色

狐狸学Excel

各位大神，
想实现下图效果，我自己也写了一段代码可以实现，但是，数据多了就有点慢，看能不能优化。请赐教！



Sub 快速填色()
Dim i, m, k
i = 2
m = 0
Do While Cells(i, 1) <> ""
    If Cells(i, 1) <> Cells(i - 1, 1) Then
        m = m + 1
    Else
       m = m
    End If
    k = m Mod 2
   
    If k = 1 Then
            Range("A" & i & ":" & "W" & i).Interior.ThemeColor = xlThemeColorAccent4
            Range("A" & i & ":" & "W" & i).Interior.TintAndShade = 0.799981688894314
        Else
            Range("A" & i & ":" & "W" & i).Interior.ThemeColor = xlThemeColorAccent6
            Range("A" & i & ":" & "W" & i).Interior.TintAndShade = 0.799981688894314
        End If
    i = i + 1
Loop
End Sub

砂海

直接搜索 "vba 提速"

hkho1221

試試找找 union 的方法把要變色的先 group 起來要一次過變色

金樽空对月

能实现就可以了，没有必要那么快，数据再多，两秒之内能完成，就是比较快的了。
测了一下运行时间，完成三千行，显示时间几乎为0。