Заменить цвет заливки ячейки на основе существующего цвета заливки ячейки в столбце

Question

Я приложил скриншот, чтобы визуализировать, что я пытаюсь сделать.

Я пытаюсь заменить цвета заливки ячеек в столбце "Вчера" на основе существующего цвета заливки ячейки.

Я видел примеры замены цветов на основе значения в ячейке, но я думаю, что у меня другой сценарий.

Answer 1

Может быть, это может помочь вам:

Option Explicit

Public Sub main()
    Dim cell As Range, foundCells As Range
    Dim yesterdayColor As Long, todayColor As Long

    yesterdayColor = Range("H3").Interior.Color
    todayColor = Range("H4").Interior.Color

    With Range("B5:B17") '<--| reference wanted range of which coloring any "yesterdayColor" colored cells with "todayColor" color
        Set foundCells = .Offset(, .Columns.Count).Resize(1, 1) '<-- initialize a dummy "found" cell outside the relevant range and avoid 'IF' checking in subsequent 'Union()' method calls
        For Each cell In .Cells '<--| loop through referenced range cells
            If cell.Interior.Color = yesterdayColor Then Set foundCells = Union(foundCells, cell) '<--| gather yesterday colored cells together
        Next cell
        Set foundCells = Intersect(.Cells, foundCells) '<--| get rid of the dummy "found" cell
    End With
    If Not foundCells Is Nothing Then foundCells.Interior.Color = todayColor '<--| if any cell has been found then change their color
End Sub

Answer 2

Изменить: попробуйте это.

Public Sub ChangeCellColors()
  Dim rngTarget As Excel.Range: Set rngTarget = Range("H3")
  Dim rngSource As Excel.Range: Set rngSource = Range("H4")
  Dim rngCell As Excel.Range

  For Each rngCell In Range("B4:B17")
    With rngCell.Interior
      If rngCell.Interior.Color = rngTarget.Interior.Color Then
        .Pattern = rngSource.Interior.Pattern
        .PatternColorIndex = rngSource.Interior.PatternColorIndex
        .Color = rngSource.Interior.Color
        .TintAndShade = rngSource.Interior.TintAndShade
        .PatternTintAndShade = rngSource.Interior.PatternTintAndShade
      End If
    End With
  Next rngCell

  Set rngSource = Nothing
  Set rngTarget = Nothing
  Set rngCell = Nothing
End Sub