在For Each循环中设置Excel单元格内部颜色的问题

原始代码 #

Sub ColourChange()
    Set WS = Sheets("Days")
    Set WC = Sheets("Runs")

    Dim pr As Long
    Dim rr As Long
    Dim hr As Long
    Dim CurrRow As Long
    Dim PrevRow As Long
    Dim CurrColor As Long
    Dim ColorArr As Variant
    Dim ColorIndex As Integer
    Dim ColorRange As Range
    Dim Color0 As Long
    Dim Color1 As Long
    Dim Color2 As Long
    Dim Color3 As Long
    Dim Color4 As Long
    Dim Color5 As Long
    Dim Color6 As Long
    Dim Color7 As Long
    Dim Color8 As Long
    Dim Color9 As Long
    Dim Color10 As Long
    Dim Color11 As Long
    Dim tms As Long

    ColorArr = Array(Color0, Color1, Color2, Color3, Color4, Color5, Color6, Color7, Color8, Color9, Color10, Color11)
    ColorIndex = 0
        Color0 = RGB(33, 139, 130)
        Color1 = RGB(154, 217, 219)
        Color2 = RGB(229, 219, 217)
        Color3 = RGB(152, 212, 187)
        Color4 = RGB(235, 150, 170)
        Color5 = RGB(106, 76, 147)


    pr = WC.Range("A" & Rows.Count).End(xlUp).Row + 13
    Debug.Print pr
    Dim TabTimes As Range
    Set TabTimes = Application.Range("Days!B15:B" & pr)
    TabTimes.Select

    tms = pr + 3
    Debug.Print tms
    pr = WC.Range("H" & Rows.Count).End(xlUp).Row
    pr = pr + tms - 1
    Debug.Print pr
    Dim CPTTimes As Range
    Set CPTTimes = Application.Range("Days!B" & tms & ":B" & pr)

    For Each cel In TabTimes.Cells
        If cel.Interior.Color <> RGB(166, 166, 166) Then
            cel.Interior.Color = ColorArr(ColorIndex)
            ColorIndex = ColorIndex + 1
        End If
    Next cel
    On Error Resume Next
End Sub

问题描述 #

我想用预设的颜色数组给B列从B15开始的指定单元格设置底色，用For Each循环遍历单元格，让不同时段对应不同预设颜色，另外还有配套代码让用户自定义RGB配色。现在代码运行后大部分单元格变成黑色，只有最后一个显示预设颜色，求修复思路（命名范围的问题暂时不用管）。

（附表格截图：B列从B15开始的单元格区域，需要按时段区分着色）

问题根源 #

1. 颜色数组初始化顺序错误：你先创建了ColorArr，但此时Color0到Color11都是未赋值的默认值0（对应黑色），之后再给这些变量赋值时，数组里的元素不会跟着更新，所以循环里前几次取到的都是黑色。
2. 索引越界风险：只定义了6种有效颜色，但如果符合条件的单元格超过6个，ColorIndex会超出数组长度，On Error Resume Next掩盖了这个错误，导致后续颜色设置失效。

修复后的代码 #

Sub ColourChange()
    Set WS = Sheets("Days")
    Set WC = Sheets("Runs")

    Dim pr As Long
    Dim ColorArr As Variant
    Dim ColorIndex As Integer
    Dim tms As Long
    Dim TabTimes As Range
    Dim cel As Range ' 显式声明循环变量

    ' 直接创建包含正确RGB值的颜色数组，跳过多余的Color0-Color11变量
    ColorArr = Array( _
        RGB(33, 139, 130), _
        RGB(154, 217, 219), _
        RGB(229, 219, 217), _
        RGB(152, 212, 187), _
        RGB(235, 150, 170), _
        RGB(106, 76, 147) _
    )
    ColorIndex = 0

    pr = WC.Range("A" & Rows.Count).End(xlUp).Row + 13
    Debug.Print pr
    Set TabTimes = WS.Range("B15:B" & pr) ' 用已定义的WS引用工作表，避免硬编码

    tms = pr + 3
    Debug.Print tms
    pr = WC.Range("H" & Rows.Count).End(xlUp).Row
    pr = pr + tms - 1
    Debug.Print pr
    Set CPTTimes = WS.Range("B" & tms & ":B" & pr)

    For Each cel In TabTimes.Cells
        If cel.Interior.Color <> RGB(166, 166, 166) Then
            ' 用Mod实现颜色循环复用，避免索引越界
            cel.Interior.Color = ColorArr(ColorIndex Mod (UBound(ColorArr) + 1))
            ColorIndex = ColorIndex + 1
        End If
    Next cel
    ' 移除On Error Resume Next，方便调试问题
End Sub

关键修改说明 #

1. 调整数组创建逻辑：直接把RGB值写入数组，确保数组一开始就有正确的颜色值，不需要单独声明Color0-Color11变量，简化代码。
2. 添加颜色循环机制：用ColorIndex Mod (UBound(ColorArr) + 1)让颜色在预设范围内循环，就算符合条件的单元格超过6个，也不会报错，会重复使用颜色。
3. 规范变量声明：显式声明cel变量，符合VBA的变量声明要求，避免隐式变量带来的问题。
4. 优化工作表引用：用WS变量代替硬编码的"Days"，让代码更健壮。
5. 移除错误掩盖：去掉On Error Resume Next，这样后续出现问题能直接看到错误提示，便于调试。

自定义配色扩展 #

如果要支持用户自定义配色，可以让用户在工作表的指定区域输入RGB值（比如Days表的D1:D6，每行输入"R,G,B"格式的数值），然后读取这些值生成颜色数组：

Dim i As Integer
ReDim ColorArr(0 To 5) ' 对应6种颜色
For i = 0 To 5
    Dim rgbParts As Variant
    rgbParts = Split(WS.Range("D" & i + 1).Value, ",")
    ColorArr(i) = RGB(Val(rgbParts(0)), Val(rgbParts(1)), Val(rgbParts(2)))
Next i

内容的提问来源于stack exchange，提问作者Mike T