基于文本单元格为Excel行着色

Question

我正在尝试根据列A中的一些关键术语为数据行着色。一些行需要是绿色的，而一些行则需要是红色的

我在网上找到了这个，但当我运行它时，表上什么都没有发生。我真的不知道为什么或如何修复它。这是我excel表中的版本，所以里面有我所有的信息。

Public Sub ColorCHange2()
Dim mapping As Object, itm As Variant

Set mapping = CreateObject("Scripting.Dictionary")

mapping(XlRgbColor.rgbLightPink) = Array("exclude from emails","exclude from listings")
mapping(XlRgbColor.rgbLightGreen) = Array("include in billing list","include in emails")

Application.ScreenUpdating = False
Sheet1.AutoFilterMode = False
With Sheet1.UsedRange
.Interior.ColorIndex = xlColorIndexNone
For Each itm In mapping
.AutoFilter Field:=1, Criterial1:=mapping(itm), Operator:=xlFilterValues
.Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Interiror.Color = itm

Next
.AutoFiler
End With
Application.ScreenUpdating = True
End Sub

Answer 1

修复您的拼写错误，以及您的代码不仅为可见单元格着色的事实。。。

Public Sub ColorCHange2()
Dim mapping As Object, itm As Variant, rngVis As Range

Set mapping = CreateObject("Scripting.Dictionary")

mapping(XlRgbColor.rgbLightPink) = Array("exclude from emails", "exclude from listings")
mapping(XlRgbColor.rgbLightGreen) = Array("include in billing list", "include in emails")

Application.ScreenUpdating = False
Sheet1.AutoFilterMode = False
With Sheet1.UsedRange
.Interior.ColorIndex = xlColorIndexNone
For Each itm In mapping
.AutoFilter Field:=1, Criteria1:=mapping(itm), Operator:=xlFilterValues
Set rngVis = Nothing
On Error Resume Next
Set rngVis = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rngVis Is Nothing Then rngVis.Interior.Color = itm
Next
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub