excel - 复制单元格背景颜色并将其粘贴到另一张工作表的相应单元格中

Question

我在工作表 1 上有值，并且使用条件格式指定了背景颜色。

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

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

我使用两种颜色，红色和白色。红色代表较高值(value)，白色代表较低值(value)。

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

Answer 1

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

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

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

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