填充，图案和字体

Question

找到了此代码，它确实满足了我的要求。我有多个条件（20），并希望根据查找设置字体，背景，图案颜色。

我需要：在sheet2范围A：A上，如果值与颜色表上的J：J列匹配，则将应用相应的填充/图案颜色/字体颜色。

我有：在“颜色”表的“ G”中填充颜色。颜色表中“ H”中的图案颜色。颜色表“ I”中的字体颜色。颜色表“ J”中的颜色代码。example

有人会这么友好地为我修改它，使其也以改变背景的方式更改图案颜色，字体颜色吗？

尝试了几个小时，可惜失败了。我认为这与设置范围和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

您可以使用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

Answer 2

填充，图案和字体

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

动态条件格式（索引，匹配）

2 个答案:

填充，图案和字体