复制单元格背景颜色并将其粘贴到另一张纸的相应单元格答案

【问题标题】：Copy cell background color and paste it to corresponding cell of another sheet复制单元格背景颜色并将其粘贴到另一张纸的相应单元格
【发布时间】：2015-07-08 23:42:33
【问题描述】：

我在工作表 1 上有值，我使用条件格式给出了背景颜色。

我只想复制颜色并将其粘贴到工作表 2 的相应单元格而不粘贴值。

例如，如果工作表 1 单元格 A1 具有特定值的红色，则将颜色转移到工作表 2 A1。

我使用两种颜色，红色和白色。红色代表较高的价值，白色代表较低的价值。

Sub copycolor()
    Dim intRow As Integer
    Dim rngCopy As Range
    Dim rngPaste As Range

    For intRow = 1 To 20

        Set rngCopy = Sheet1.Range("A" & intRow + 0)
        Set rngPaste = Sheet2.Range("b" & intRow)

        'Test to see if rows 500+ have a value
        If rngCopy.Value <> "" Then

            'Since it has a value, copy the value and color
            rngPaste.Value = rngCopy.Value
            rngPaste.Interior.Color = rngCopy.Interior.Color

        End If
    Next intRow
End Sub

【问题讨论】：

条件格式简单吗？我在考虑而不是复制颜色。检查该值是否满足条件格式，如果满足则将 rngPaste 颜色更改为该颜色

标签： excel vba

【解决方案1】：

.Interior.Color 获取单元格的实际颜色，而不是条件格式的颜色（您看到的颜色）。所以你不能以这种方式在你的例子中复制/粘贴这种红色。

我相信，获得您看到的条件格式颜色的唯一方法是重新计算您在条件格式标准中使用的任何公式。

Excel 2007 conditional formatting - how to get cell color?

编辑

虽然@JeffK627 提供了一个优雅的解决方案，但我正在敲出一些粗略的 vba 代码来重新计算我收集到的条件格式所做的事情。我已经在工作表 2 上的 A1:A20 范围内完成了此操作。目前它为包含值本身的单元格着色，但只需要稍作调整即可为另一张表上的等效单元格着色。

Sub ColouringIn()

    Dim intColIndex As Integer
    Dim dblMax As Double
    Dim dblMin As Double
    Dim rngCell As Range

    'RGB(255, 255, 255) = white
    'RGB(255, 0, 0) = red
    'so need to extrapolate between

    dblMax = Application.WorksheetFunction.Max(Sheet2.Range("A1:A20"))
    dblMin = Application.WorksheetFunction.Min(Sheet2.Range("A1:A20"))

    For Each rngCell In Sheet2.Range("A1:A20")
        If IsNumeric(rngCell.Value) And rngCell.Value <> "" Then
            intColIndex = (rngCell.Value - dblMin) / (dblMax - dblMin) * 255
            rngCell.Interior.Color = RGB(255, intColIndex, intColIndex)
        End If
    Next rngCell

End Sub

【讨论】：

【解决方案2】：

最简单的方法是将相同的条件格式应用于 Sheet2，但使用 Sheet1 中的值作为您的标准。因此，如果 Sheet1 单元格 A1 具有使其变为红色的值，请将格式添加到 Sheet2 以将 Sheet2 单元格 A1 也变为红色。

有一个很好的解释如何实现这个here。

【讨论】：

为了防止链接失效的潜在问题，您应该在答案中重现链接中的步骤（除了发布链接）。

【解决方案3】：

rngPaste.Interior.Color = rngCopy.DisplayFormat.Interior.Color

似乎对我有用。请记住，DisplayFormat 是只读的，不允许在使用它的函数之外返回值。此外，它仅在 Excel 2010 + 中可用

我正在编辑我的答案以包含您提到的其他内容，并意识到将其全部解释为单独的块会变得令人困惑。这是实现您所说的推荐的方法。

Public Sub CopyColor()
Dim SourceSht As Worksheet
Dim TargetSht As Worksheet
Dim rngCopy As Range
Dim rngPaste As Range
Dim LastCopyRow As Long
Dim LastCopyColumn As Long

'Define what our source sheet and target sheet are
Set SourceSht = ThisWorkbook.Worksheets("Sheet1")
Set TargetSht = ThisWorkbook.Worksheets("Sheet2")

'Find our used space on the source sheet
LastCopyRow = SourceSht.Cells(Rows.Count, "A").End(xlUp).Row
LastCopyColumn = SourceSht.Cells(1, Columns.Count).End(xlToLeft).Column

'Setup our ranges so we can be sure we don't loop through unused space
Set rngCopy = SourceSht.Range("A1:" & SourceSht.Cells(LastCopyRow, LastCopyColumn).Address)
Set rngPaste = TargetSht.Range("A1:" & TargetSht.Cells(LastCopyRow, LastCopyColumn).Address)

'Loop through each row of each column.
' This will go through each cell in column 1, then move on to column 2
For Col = 1 To LastCopyColumn
    For cel = 1 To LastCopyRow
        ' If the string value of our current cell is not empty.
        If rngCopy.Cells(cel, Col).Value <> "" Then
            'Copy the source cell displayed color and paste it in the target cell
            rngPaste.Cells(cel, Col).Interior.Color = rngCopy.Cells(cel, Col).DisplayFormat.Interior.Color
        End If
    Next cel
Next Col
End Sub

【讨论】：

亲爱的，您的解决方案是正确的，它的工作原理。您能否给我一个更多的解释或代码来选择整个范围，例如从第一行到最后一行和最后一列。提前致谢。@沙根
我用一个完整的例子更新了我的答案以避免混淆。我还意识到，为了保留粘贴纸上颜色的位置，这些 for 循环会比我建议的原始想法更好。只需确保：这不会复制源单元格的值，只会复制当前显示的颜色格式。

【解决方案4】：

添加以下示例作为替代解决方案，因为我需要一些动态/活动的东西，其中颜色是数据的必需条件并且不依赖于任何其他触发器。

选项1：

Dim rngPrev2Update As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cellbox As Range
    Dim rngDest As Range

    If Not rngPrev2Update Is Nothing Then
    For Each cellbox In rngPrev2Update.Cells
        Worksheets("Sheet2").Range(cellbox.Address).Interior.ColorIndex = cellbox.Interior.ColorIndex
    Next cellbox
    End If
    Set rngPrev2Update = Target

End Sub

这将在光标下一次移动到另一个单元格时更新目标单元格。

选项2：

Private Sub Worksheet_Activate()

    Dim cellbox As Range
    Dim rngCells As Range
    Set rngCells = Range("B1:B10")

    For Each cellbox In rngCells.Cells
        Range(cellbox.Address).Interior.ColorIndex = Worksheets("Sheet2").Range(cellbox.Address).Interior.ColorIndex
    Next cellbox

End Sub

将在工作表加载时更新相关单元格。

注意：如果您有非常大的数据集，您可能希望将其放入宏按钮中和/或仅针对您需要的单元格进一步过滤，否则这可能会减慢电子表格的速度。

【讨论】：

【解决方案5】：

欣赏这是不久前的事了。我想做类似的事情，但是想附加内部颜色参考，即。 255 到单元格值。

所以如果单元格 A1 在单元格中有 Hello 并且是红色的，我想在另一个工作表单元格 A1 中：你好 | 255

刚用过|作为分隔符，但任何明智的...

【讨论】：

-1 这不是答案；相反，您是在问自己的问题，略有不同。而| 将不起作用，无论是在 Excel 中还是在 VBA 中。