复制单元格背景颜色答案

【问题标题】：Copy Cell Backgroundcolor复制单元格背景颜色
【发布时间】：2018-04-10 17:25:23
【问题描述】：

我正在使用 Excel 2013，我想在 VBA 中编写一个具有两个参数（Sourcecell 和 Destinationcell）的函数，并且只需将 Backgroundcolor 从 Sourcecell 复制到 Destinationcell。这就是我所拥有的：

Function setRGB2(ByVal sCell As Range, ByVal dCell As Range)
Dim lngColor As Long
Dim B As Long
Dim G As Long
Dim R As Long

On Error GoTo Fehler

lngColor = sCell.Interior.Color
B = lngColor / 65536
G = (lngColor - B * 65536) / 256
R = lngColor - B * 65536 - G * 256

Range(dCell).Interior.Color = RGB(R, G, B)
'Range(dCell).DisplayFormat.Interior.Color = RGB(R, G, B)

Fehler:
    With Err

    End With
End Function

我得到错误：

不当使用属性

例如，我的 Sourcecell 是 B16，我的 Destinationcell 是 B46。所以在 B46 中我写了=setRGB2($B$16;B46)。我尝试像dCell.Interior.Color = sCell.Interior.Color 那样直接设置颜色，但这不起作用。

编辑

我已经为参数添加了声明。但这似乎是另一个问题。即使我这样做dCell.Interior.ColorIndex = 1，它也会抛出同样的错误。

【问题讨论】：

你是如何使用这个功能的，为什么不直接将一个单元格的Interior.Color 分配给另一个单元格呢？
你为什么不直接使用Range(dCell).Interior.Color = sCell.Interior.Color？为什么这么复杂？还要在setRGB2(sCell, dCell) 中为您的sCell, dCell 指定一个类型
请声明 sCell 和 dCell，这样我们就知道我们在说什么了。还请确保R大于0，请查看RGB
记得检查默认的无颜色，当sCell.Interior.ColorIndex = xlColorIndexNone

标签： excel excel-2013 vba

【解决方案1】：

用户定义函数不能更改工作表/单元格的状态。换句话说，不能改变颜色。 (Source)

但是Subs可以做到，所以你可以设计一个Function，然后从Sub中调用这个函数。

但在您的情况下，应该使用带参数的 Sub，您可以随时在 VBA 代码中以简单的方式调用它。

Sub testing()

setRGB2 [A1], [A2]

End Sub

Private Sub setRGB2(ByRef sCell As Range, ByRef dCell As Range)

dCell.Interior.Color = sCell.Interior.Color
End Sub

另外，我在回答开始时说过，UDF 不能更改工作表的状态，但如果出于任何原因您确实需要它，有一种方法可以以非常复杂和核心的方式来完成。

UDF to change cells color

另外，在你的问题中你说：

例如，我的 Sourcecell 是 B16，我的 Destinationcell 是 B46。所以在B46我写=setRGB2($B$16;B46)

这是错误的，因为您正在创建循环引用，这会导致您出错。

More about circular references

【讨论】：

在 UDF 上找到了更改单元格颜色的好方法！还有this链接埋在那里可能更容易实现？
我在猜测一些事情。感谢您的链接。

【解决方案2】：

不确定你想用这个函数实现什么，但下面的代码应该是正确的，至少在语法上是正确的

Option Explicit

Function setRGB2(ByVal sCell As Range, ByVal dCell As Range)
    Dim lngColor As Long
    Dim B As Long
    Dim G As Long
    Dim R As Long

'    On Error GoTo Fehler

    lngColor = sCell.Interior.Color
    B = WorksheetFunction.Max(lngColor / 65536, 0)
    G = WorksheetFunction.Max((lngColor - B * 65536) / 256, 0)
    R = WorksheetFunction.Max(lngColor - B * 65536 - G * 256, 0)

    dCell.Interior.Color = RGB(R, G, B)
    'Range(dCell).DisplayFormat.Interior.Color = RGB(R, G, B)

    Exit Function

Fehler:
    With Err

    End With
End Function

Sub TestIt()
    setRGB2 Range("A1"), Range("A2")
End Sub

【讨论】：

RGB 分割是不必要的，但使用Bitwise Operators 更容易：B = (lngColor AND rgbBlue)/65536: G=(lngColor AND rgbLime)/256: R=(lngColor AND rgbRed)
我想说，dCell.Interior.Color = sCell.Interior.Color应该就足够了。
是的，正如我所说，RGB 分割是不必要的。

【解决方案3】：

首先检查单元格是否有颜色，如果有，则复制它：

Public Sub CopyColour(ByRef Source As Range, ByRef Destination As Range)
    If Source.Interior.ColorIndex = xlColorIndexNone Then
        Destination.Interior.ColorIndex = xlColorIndexNone
    Else
        Destination.Interior.Color = Source.Interior.Color
    End If
End Sub

不管理渐变或图案。

【讨论】：