我需要一个可以搜索数据列表的宏,并根据内容列表中的数据对条目进行颜色编码。
例如,如果对应于列B(内容),则列A中的搜索数据然后对列A中的条目进行颜色编码以匹配列B中的预颜色编码数据。
我需要这个循环大约1000个条目。
提前致谢。 安迪
答案 0 :(得分:0)
我讨厌鼓励你,因为你没有遵循网站规则来说明研究并在提出问题之前尝试解决方案,并分享你已经尝试过的内容。这可能是其他人给你的问题一个负面评价的原因。
然而,你对你的问题的参数做了足够的思考,我怀疑你在编写这个问题之前可能已经尝试了一些东西,而且我正在给你怀疑的好处。这是一个可能的解决方案,如果通过“预彩色编码数据”表示单元格的内部。
更改顶部的常量以匹配数据的列和标题行。
如果您的数据的预颜色编码不是我使用的内部设置,您可以采用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