復制單元格背景顏色並將其粘貼到另一張工作表的相應單元格

Question

我在工作表 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

Answer 1

最簡單的方法是將相同的條件格式應用於 Sheet2，但使用 Sheet1 中的值作為您的條件。 因此，如果 Sheet1 Cell A1 的值使其變為紅色，則將格式添加到 Sheet2 中，使 Sheet2 Cell A1 也變為紅色。

還有如何實現這一個很好的解釋在這里。

Answer 2

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

Answer 3

.Interior.Color 獲取單元格的實際顏色而不是條件格式的顏色（您看到的顏色）。 所以你不能以這種方式在你的例子中復制/粘貼這個紅色。

我相信獲得條件格式顏色的唯一方法是重新計算您在條件格式條件中使用的任何公式。

Excel 2007 條件格式 - 如何獲取單元格顏色？

編輯

雖然@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

Answer 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

將在工作表加載時更新相關單元格。

注意：如果您有非常大的數據集，您可能希望將其放入宏按鈕和/或僅針對您需要的單元格進一步過濾，否則這可能會減慢您的電子表格速度。

Answer 5

欣賞這一點是前一段時間。 我想做一個類似的事情但是想附加室內顏色參考即。 255 到單元格值。

所以如果單元格 A1 在單元格中有你好並且是紅色我想要在另一個工作表單元格 A1 中：你好 | 255

剛用| 作為分隔符，但任何明智的...