根据列中现有的单元格填充颜色替换单元格填充颜色

Question

我附上了截图，可视化我想要做的事情。

我正在尝试根据现有的单元格填充颜色替换“昨天”列中单元格的填充颜色。

我已经看到了根据单元格中的值替换颜色的示例，但我认为我有不同的情况。

Answer 1

编辑：试试这个。

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

Answer 2

也许这可以帮到你：

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