Excel:将单元格的背景颜色更改为在该单元格中写入的RGB颜色

Arn*_*asM 2 excel vba excel-vba excel-2010

我有这个代码显示目标单元格的rgb颜色:

Function getRGB(RefCell)
Dim mystr As String
Application.Volatile
    mystr = Right("000000" & Hex(RefCell.Interior.Color), 6)
    getRGB = Application.Hex2Dec(Right(mystr, 2)) & ", " & _
             Application.Hex2Dec(Mid(mystr, 3, 2)) & ", " & _
             Application.Hex2Dec(Left(mystr, 2))
End Function
Run Code Online (Sandbox Code Playgroud)

我需要这个代码而不是炫耀其他单元格的rgb,会改变自己单元格的背景颜色.也许有人知道该怎么做?

Sid*_*out 5

MSDN KB

由工作表单元格中的公式调用的用户定义函数无法更改Microsoft Excel的环境.这意味着此类功能无法执行以下任何操作:在电子表格中插入,删除或格式化单元格.

不幸的是,这是不正确的!

您可以从调用公式的位置更改单元格的颜色.这是一个例子.这会将单元格的颜色更改Red为调用公式的位置.

诀窍是将空白值作为第一个参数传递给sub(a在下面的例子中).

它为什么有效?

我不知道!但它的工作原理:)

Function SetIt(RefCell)
    RefCell.Parent.Evaluate "getRGB(" & """""" & "," & RefCell.Address(False, False) & ")"

    SetIt = ""
End Function

Sub getRGB(a As String, RefCell As Range)
    RefCell.Interior.ColorIndex = 3 '<~~ Change color to red
End Sub
Run Code Online (Sandbox Code Playgroud)

截图

在此输入图像描述

EDIT(Credit Where Due):很久以前我曾经看过蒂姆·威廉姆斯的这个帖子,并且我已经尝试过它,并且我已经完成了很多其他知识,而KB文章说这是不可能的.

顺便说一句,我玩了更多,我能够让它工作,而不会传递空白字符串.

Function SetIt(RefCell)
    RefCell.Parent.Evaluate "getRGB(" & RefCell.Address(False, False) & ")" 
    SetIt = ""
End Function

Sub getRGB(RefCell As Range)
    RefCell.Interior.ColorIndex = 3
End Sub
Run Code Online (Sandbox Code Playgroud)

编辑

来自重复的问题和聊天(以下评论)

将其粘贴到代码模块中,然后在单元格中P20粘贴公式=setit(P20,N20)

Function SetIt(DestCell As Range, RefCell As Range)
    RefCell.Parent.Evaluate "SetAndGetRGB(" & RefCell.Address(False, False) & _
                                        "," & _
                                        DestCell.Address(False, False) & ")"

    SetIt = ""
End Function

Sub SetAndGetRGB(RefCell As Range, DestCell As Range)
    Dim sRGB As String
    Dim shName As String

    shName = Split(RefCell.Value, "!")(0)
    sRange = Split(RefCell.Value, "!")(1)

    sRGB = Right("000000" & Hex(Sheets(shName).Range(sRange).Interior.Color), 6)

    DestCell.Interior.Color = RGB( _
                                    Application.Hex2Dec(Right(sRGB, 2)), _
                                    Application.Hex2Dec(Mid(sRGB, 3, 2)), _
                                    Application.Hex2Dec(Left(sRGB, 2)) _
                                  )
End Sub
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

注意:我没有做任何错误处理.我相信你可以照顾到这一点.