Динамическое условное форматирование (индекс, совпадение)

Question

Нашел этот код и он "часть" того, что мне нужно.У меня есть несколько условий (20) и я хочу установить шрифт, фон, цвет рисунка на основе поиска.

Мне нужно: На листе 2 диапазон A: A, если значение соответствует столбцу J: J на ​​цветном листе, топрименяются соответствующие заливка / цвет рисунка / цвет шрифта.

У меня есть: Цвет заливки в «G» листа «Цвета».Цвет узора в «Н» листа цветов.Цвет шрифта в «I» листа «Цвета».Цветовые коды в «J» листа «Цвета». пример

Может ли кто-нибудь быть таким добрым и изменить его, чтобы я также изменил цвет рисунка, цвет шрифта так же, как он меняет фон?

Пытался пару часов и, к сожалению, не смог.Я считаю, что это как-то связано с настройкой диапазонов и interior.pattern / colorindex и т. Д.

Разве у вас нет более простого способа, чем этот?Надеюсь, я понял.Жарил немного, мои извинения.

Код:

Sub SetColors()

    ' DataCells: The cells that's going to be checked against the color values
    Set DataCells = Range("A1:A15") ' Update this value according to your data cell range

    ' ColorValueCells: The cells that contain the values to be colored
    Set ColorValueCells = Sheets("Colors").Range("j2:j41") ' Update this value according to your color value + index range

    ' Loop through data cells
    For Each DataCell In DataCells

        ' Loop through color value cells
        For Each ColorValueCell In ColorValueCells

            ' Search for a match
            If DataCell.Value = ColorValueCell.Value Then

                ' If there is a match, find the color index
                Set ColorIndexCell = Sheets("Colors").Range("g" & ColorValueCell.Row)


                ' Set data cell's background color with the color index
                DataCell.Interior.ColorIndex = ColorIndexCell.Value


            End If
        Next
    Next
End Sub

Answer 1

Fill, Pattern & Font

• Sheet2 - это кодовое имя листа.Вы можете переименовать его на вкладке.

• Переменные столбца объявлены как вариант, чтобы можно было использовать либо номера столбцов, либо буквы столбцов.

  Option Explicit
  
  Sub FillColors()
  
    Const cStrRange As String = "A1:A15"  ' Target Range Address
    Const cStrColor As String = "J2:J41"  ' ColorIndex Range Address
    Const cVntFill As Variant = "G"       ' Fill ColorIndex Column
    Const cVntPattern As Variant = "H"    ' Pattern ColorIndex Column
    Const cVntFont As Variant = "I"       ' Font ColorIndex Column
  
    Dim Datacells As Range                ' Target Range
    Dim ColorValueCells As Range          ' ColorIndex Range
    Dim DataCell As Range                 ' Target Range Current Cell
    Dim ColorValueCell As Range           ' ColorIndex Range Current Cell
    Dim ColorIndexCell As Range           ' ColorIndex Match Cell
  
    With Sheet2
      Set Datacells = .Range(cStrRange)
      Set ColorValueCells = .Range(cStrColor)
      For Each DataCell In Datacells
        For Each ColorValueCell In ColorValueCells
          If DataCell.Value = ColorValueCell.Value Then
            Set ColorIndexCell = .Cells(ColorValueCell.Row, cVntFill)
            DataCell.Interior.ColorIndex = ColorIndexCell.Value
            Set ColorIndexCell = .Cells(ColorValueCell.Row, cVntPattern)
            DataCell.Interior.PatternColorIndex = ColorIndexCell.Value
            Set ColorIndexCell = .Cells(ColorValueCell.Row, cVntFont)
            DataCell.Font.ColorIndex = ColorIndexCell.Value
          End If
        Next
      Next
    End With
  
    Set ColorIndexCell = Nothing
    Set ColorValueCell = Nothing
    Set DataCell = Nothing
    Set ColorValueCells = Nothing
    Set Datacells = Nothing
  
  End Sub
  

Answer 2

Вы можете использовать Find() вместо вложенного цикла:

Sub SetColors()
    Dim DataCells As Range, ColorValueCells As Range
    Dim datacell As Range, f As Range

    Set DataCells = Range("A1:A15")
    Set ColorValueCells = Sheets("Colors").Range("J2:J41")

    For Each datacell In DataCells

        Set f = ColorValueCells.Find(datacell.Value, lookat:=xlWhole) '<< match the color
        If Not f Is Nothing Then
            'got a match: set the properties from this row
            With datacell
                .Interior.ColorIndex = Sheets("Colors").Cells(f.Row, "G").Value
                'etc for any other settings...
            End With
        End If
    Next
End Sub

РЕДАКТИРОВАТЬ: вместо сохранения различных настроек форматирования в ячейках в той же строке, что и ячейка f, вы можете рассмотреть форматированиекаждая из этих ячеек, как вам нужно, затем копирование настроек непосредственно из f в каждую из целевых ячеек.

Например,

With datacell
    .Interior.ColorIndex = f.Interior.ColorIndex
    'etc for any other settings...
End With