复制单元格背景颜色，并将其过去与另一个单元格相对应

我一直在试图写一个macros来复制单元格背景颜色，并将其过滤到另一个sheet的相应单元格。我在Sheet 1上有很多值，并且使用条件格式给出了背景颜色，之后我只想复制颜色并将其粘贴到相应的单元格2的单元格中，而不粘贴值。例如，如果单元格A1具有特定值的红色，我想将该颜色传输到单元格2 A1。 我给的Excel表1和我的代码的图片。

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 +

我正在编辑我的答案，包括你提到的其他东西，并意识到这是越来越混乱，以单独的大块解释。 这是一个推荐的方法来实现你所说的。

 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 2

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

这里有一个很好的解释。

Answer 3

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

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

Excel 2007条件格式 – 如何获取单元格颜色？

编辑

虽然@ JeffK627提供了一个优雅的解决scheme，我敲了一些粗糙的VBA代码重新计算我收集您的条件格式。 我已经完成了超过范围A1：A20在工作表2上。目前，它的颜色包含值本身的单元格，但只需要一点点调整，在另一个工作表上的等效单元格。

 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