excel - vba 根据内容列表搜索列表和颜色代码匹配。

Question

我需要一个宏，它可以搜索数据列表并根据内容列表中的数据对条目进行颜色编码。

例如，如果对应于 B 列（内容），则在 A 列中搜索数据，然后对 A 列中的条目进行颜色编码以匹配 B 列中的预颜色编码数据。

我需要这个来循环大约 1000 个条目。

提前致谢。安迪

Answer 1

我不想鼓励你，因为你没有遵循网站规则，即在提出问题之前研究并尝试解决方案，并分享你已经尝试过的东西。这可能就是为什么其他人对您的问题给予负面评价的原因。

但是，您对问题的参数进行了足够多的思考，我怀疑您在撰写此问题之前可能已经尝试过一些东西，并且我同意您的怀疑。这是一个可能的解决方案，如果“预颜色编码数据”是指单元格的内部。

更改顶部的常量以匹配数据的列和标题行。

如果您的数据的预颜色编码不是我使用的内部设置，您可以采用 Marty McVry 的建议，即使用宏记录器来确定您正在更改哪些设置并将它们合并到此代码中（代码所在的With rCell.Interior位置） .

Sub MatchColor()

Const sColumnID As String = "A"
Const iHeaderID As Integer = 1

Dim rCell As Range
Dim rColumn As Range

Set rColumn = Range(sColumnID & iHeaderID, Range(sColumnID & iHeaderID).End(xlDown))

For Each rCell In rColumn

    If rCell.Value = rCell.Offset(0, 1).Value Then
        With rCell.Interior
            .Pattern = rCell.Offset(0, 1).Interior.Pattern
            .PatternColorIndex = rCell.Offset(0, 1).Interior.PatternColorIndex
            .ThemeColor = rCell.Offset(0, 1).Interior.ThemeColor
            .TintAndShade = rCell.Offset(0, 1).Interior.TintAndShade
            .PatternTintAndShade = rCell.Offset(0, 1).Interior.PatternTintAndShade
        End With
    End If

Next rCell

End Sub