Excel VBA - 根据包含另一列的 RGB 值设置颜色

Question

作为更大过程的一部分，我需要创建一个 Excel VBA 宏，它从列中读取值并根据每个单元格中的值对行应用基本格式。

电子表格本身是从另一个程序中导出的，并直接在 Excel 中打开。所有列都格式化为General

顺序是这样的：

1. 从 Sheet1 中的第二行开始
2. 查看J 列
3. 读取RGB值（显示为RGB(X,Y,Z)，其中X、Y和Z是颜色的数值需要用到）
4. 将 Column A-I 的行文本颜色更改为该颜色
5. 继续浏览所有带有文本的行

我找到了this thread，但我无法让它工作。

非常感谢这里的任何帮助。

Answer 1

Sub ColorIt()
    Set cl = Cells(2, "J")
    Do Until cl = ""
        txt = cl.Value2
        cl.Offset(, -9).Resize(, 9).Font.Color = _
            Evaluate("SUMPRODUCT({" & Mid(txt, 5, Len(txt) - 5) & "},{1,256,65536})")
        Set cl = cl.Offset(1)
    Loop
End Sub

结果：

编辑2

Sub ColorIt2()
    Const RGB_COL = "M"
    
    Set cl = Cells(2, RGB_COL)
    Do Until cl = ""
        txt = cl.Value2
        cl.Offset(, 1 - cl.Column).Resize(, cl.Column - 1).Interior.Color = _
            Evaluate("SUMPRODUCT({" & Mid(txt, 5, Len(txt) - 5) & "},{1,256,65536})")
        Set cl = cl.Offset(1)
    Loop
End Sub

Answer 2

请使用下一个功能。它将字符串转换为 Long 颜色（基于 RGB 三个参数。它适用于逗号分隔符（“，”和“，”）的大小写：

Function ExtractRGB(strRGB As String) As Long
   Dim arr: arr = Split(Replace(strRGB, " ", ""), ",")
   ExtractRGB = RGB(CLng(Right(arr(0), Len(arr(0)) - 4)), CLng(arr(1)), CLng(left(arr(2), Len(arr(2)) - 1)))
End Function

可以用下一种方式测试：

Sub TestExtractRGB()
  Dim x As String, color As Long
  x = "RGB(100,10,255)"
  x = "RGB(100, 10, 255)"
  color = ExtractRGB(x)
  Debug.Print color
  Worksheet("Sheet1").Range("A2:I2").Font.color = color
  'or directly:
  Worksheet("Sheet1").Range("A2:I2").Font.color = _
      ExtractRGB(Worksheet("Sheet1").Range("J2").value)
End Sub

如果您评论x = "RGB(100, 10, 255)"，它将返回与之前的x字符串相同的颜色值...

如果您需要对所有现有行执行此操作，则代码必须从 2 迭代到最后一行，您只需将“A2:I2”更改为 "A" & i & ":I" & i

如果有必要，我可以教你怎么处理，不过我觉得很简单……