копировать цвет фона ячейки и минуть соответствующую ячейку другого листа

Question

Я пытаюсь написать макрос для копирования цвета фона ячейки и мимо него в соответствующую ячейку другого листа. У меня есть много значений на Листе 1, и я дал цвет фона с использованием условного форматирования, после чего я хочу скопировать только цвет и пропустить его соответствующую ячейку листа 2 без вставления значения. Например, если ячейка 1 листа 1 имеет красный цвет для определенного значения, я хочу перенести цвет на лист 2 A1 , Я даю картину excel sheet 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 

Я использую условное форматирование для придания цвета и здесь я использую два color.one красный, а другой является white.Red является использование более высоким значения и белым для нижней vaue. Было бы неплохо, если бы вы помогли мне решить эту проблему.

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

. Interior.Color получает фактический цвет ячейки, а не условно отформатированный цвет (тот, который вы видите). Таким образом, вы не можете копировать/вставлять этот красный цвет в свой пример таким образом.

Я считаю, что единственный способ получить условно отформатированный цвет, который вы видите, состоит в том, чтобы пересчитать любую формулу, которую вы использовали в ваших условно-форматирующих критериях.

Excel 2007 conditional formatting - how to get cell color?

Редактировать

Хотя @ JeffK627 давал элегантное решение, я стучался некоторый грубый код 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 

Answer 3

Простейшим было бы применить такое же условное форматирование к Sheet2, но использовать значения из Sheet1 в качестве ваших критериев. Поэтому, если у Sheet1 Cell A1 есть значение, которое делает его красным, добавьте форматирование в Sheet2, которое также увеличит значение Sheet2 Cell A1.

Существует хорошее объяснение того, как достичь этого here.