VBA调度表自动着色时出现运行时错误'13'类型不匹配问题

问题描述 #

要给调度表实现自动着色，每位员工对应唯一颜色，新增员工时能自动更新。具体规则：

• Staff工作表C列存储格式为RGB(123, 123, 123)的颜色值；
• Schedule工作表I5:AN21（正式范围为I5:NJ1000）单元格填充员工首字母，需与Staff工作表D列的首字母匹配。

执行代码时，Set colorPick = staffSheet.Cells(cellColorMatch, 3).Value这行持续触发运行时错误'13'：类型不匹配，但直接使用cell.Interior.Color = RGB(255, 125, 194)这种方式赋值背景色可正常生效。

错误原因分析 #

1. 误用Set关键字：Set仅用于给对象变量赋值，而staffSheet.Cells(cellColorMatch,3).Value是字符串类型（如"RGB(123,123,123)"），并非对象，用Set赋值会直接导致类型不匹配。
2. 字符串无法直接转为颜色值：即使去掉Set，字符串格式的RGB表达式也不能直接赋值给cell.Interior.Color——该属性需要的是RGB()函数生成的数值型颜色值，而非文本字符串。

修复后的代码 #

需要解析Staff表C列的RGB字符串，提取红、绿、蓝分量后，再用RGB()函数生成合法的颜色值，同时优化匹配逻辑避免错误：

Sub ColorCellsBasedOnText()
    Dim staffSheet As Worksheet, scheduleSheet As Worksheet
    Dim colorRange As Range, textRange As Range, cell As Range
    Dim cellColorRow As Variant, cellColorMatch As Long
    Dim rgbStr As String, rgbParts() As String
    Dim r As Integer, g As Integer, b As Integer
    
    ' 指定目标工作表
    Set staffSheet = Sheets("Staff")
    Set scheduleSheet = Sheets("Schedule")
    
    ' 获取Staff表C列有效数据范围（从C2开始）
    Dim lastStaffRow As Long
    lastStaffRow = staffSheet.Cells(staffSheet.Rows.Count, "C").End(xlUp).Row
    Set colorRange = staffSheet.Range("C2:C" & lastStaffRow)
    
    ' 指定Schedule表需要着色的范围
    Set textRange = scheduleSheet.Range("I5:AN21") ' 正式环境替换为I5:NJ1000
    
    For Each cell In textRange
        If Not IsEmpty(cell) Then
            ' 匹配Staff表D列的员工首字母
            cellColorRow = Application.Match(Trim(cell.Value), staffSheet.Range("D2:D" & lastStaffRow), vbBinaryCompare)
            
            If Not IsError(cellColorRow) Then
                cellColorMatch = cellColorRow + 1 ' 转换为实际行号（匹配从D2开始）
                
                ' 解析RGB字符串
                rgbStr = staffSheet.Cells(cellColorMatch, "C").Value
                rgbStr = Replace(Replace(rgbStr, "RGB(", ""), ")", "") ' 去除RGB()包裹
                rgbParts = Split(rgbStr, ",") ' 按逗号分割颜色分量
                
                ' 转换为整数并生成颜色值
                r = CInt(Trim(rgbParts(0)))
                g = CInt(Trim(rgbParts(1)))
                b = CInt(Trim(rgbParts(2)))
                
                ' 应用背景色
                cell.Interior.Color = RGB(r, g, b)
            End If
        End If
    Next cell
End Sub

额外优化说明 #

• 修正了原代码中Match函数的范围错误：原写法D2:D100" & colorRange.Rows.Count会生成无效范围（如colorRange有10行时，会变成D2:D10010），现在改为D2:D" & lastStaffRow，范围更准确。
• 补充了变量类型声明：避免未声明变量导致的潜在问题。
• 移除了冗余调试语句，保持代码简洁（如需调试可自行添加）。

内容的提问来源于stack exchange，提问作者Cameron Johnston