/ / Zamień kolor wypełnienia komórki na podstawie istniejącego koloru wypełnienia komórki w kolumnie - excel, vba, makra, kolor tła, komórki

Zastąp kolor wypełnienia komórki na podstawie istniejącego koloru wypełnienia komórki w kolumnie - excel, vba, makra, kolor tła, komórki

Załączam zrzut ekranu, aby zobrazować to, co próbuję zrobić.

wprowadź opis obrazu tutaj

Próbuję zastąpić kolory wypełnienia komórek w kolumnie "Wczoraj" na podstawie istniejącego koloru wypełnienia komórki.

Widziałem przykłady zastępowania kolorów na podstawie wartości w komórce, ale myślę, że mam inny scenariusz.

Odpowiedzi:

0 dla odpowiedzi № 1

może to pomoże:

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

0 dla odpowiedzi nr 2

Edycja: wypróbuj to.

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