如何使用 Change(byVal Target as Range) to check/change 单元格颜色

Question

我的主要数据条目是一个名为“Master”的工作表。我想在输入单词时检查范围 A2:A1000。如果它是“CBI”、“Fire”、“InCase”或“LEA”，则 I 列 (Offset(0, 8)) 中不需要发生任何事情，因为它已经没有填充 (Interior.ColorIndex = -4142 ).但是，如果在范围 A2:A1000 中输入了任何其他单词，第 I 列 (Offset(0, 8)) 将更改为不同的颜色 (Interior.Color = RGB(255, 231, 255))。我选择了带有“工作表”和“更改”的离散工作表，但无法使相交起作用。我知道代码是重复的……我想使用多个参数，例如“CBI”、“Fire”、“InCase”、“LEA”……但它在 firstIf Target 行崩溃。或者，Select Case 参数可能更好。我在搜索“运行 vba when cell change”时查看了 Whosebug 结果，并尝试修改但没有成功。我还在单独的模块中尝试了几次编码尝试，在那里我有我的其他 Subs 运行很好，但对此提供帮助将不胜感激。

        Private Sub Worksheet_Change(ByVal Target As Range)

        'Change interior color in Offset cell if certain words not entered in Range A2:A1000

            If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then

                If Target(Range("A2:A1000"), "CBI") > 0 Then
                    ActiveCell.Offset(0, 8).Interior.ColorIndex = -4142
            Else
                If Target(Range("A2:A1000"), "Fire") > 0 Then
                    ActiveCell.Offset(0, 8).Interior.ColorIndex = -4142
            Else
                If Target(Range("A2:A1000"), "InCase") > 0 Then
                    ActiveCell.Offset(0, 8).Interior.ColorIndex = -4142
            Else
              If Target(Range("A2:A1000"), "LEA") > 0 Then
                    ActiveCell.Offset(0, 8).Interior.ColorIndex = -4142
            Else
                ActiveCell.Offset(0, 8).Interior.Color = RGB(255, 231, 255)
            End If
  
          End If

        End Sub

Answer 1

根据另一个单元格的值调整颜色

这将根据在第 A 列中手动输入（不是通过公式）的值调整第 I 列中单元格的颜色。如果第 A 列不包含列表中的值，则第 I 列同一行中的单元格将被着色。
如果您在 A 列中已有值，您可以简单地 select 它们并执行 'copy/paste'，然后 I 列中的颜色将被更新。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Const sCriteriaList As String = "CBI,Fire,InCase,LEA" ' no spaces!
    Const sfCellAddress As String = "A2"
    Const dCol As String = "I"
    Dim diColor As Long: diColor = RGB(255, 231, 255)
    
    Dim sfCell As Range: Set sfCell = Range(sfCellAddress)
    Dim scrg As Range: Set scrg = sfCell.Resize(Rows.Count - sfCell.Row + 1)
    Dim srg As Range: Set srg = Intersect(scrg, Target)
    If srg Is Nothing Then Exit Sub
    
    Dim sCriteria() As String: sCriteria = Split(sCriteriaList, ",")
    
    Dim drg As Range: Set drg = Intersect(srg.EntireRow, Columns(dCol))
    
    Dim durg As Range
    Dim r As Long
    
    For r = 1 To srg.Cells.Count
        If IsError(Application.Match(CStr(srg.Cells(r)), sCriteria, 0)) Then
            If durg Is Nothing Then
                Set durg = drg.Cells(r)
            Else
                Set durg = Union(durg, drg.Cells(r))
            End If
        End If
    Next r
    
    drg.Interior.Color = xlNone
    If Not durg Is Nothing Then
        durg.Interior.Color = diColor
    End If
 
End Sub

编辑：

您的新想法需要修改两行：

    Const sCriteriaList As String = "*BI,*EA,*PD,*SO,*TF" ' no spaces!

        If Application.Count(Application _
                .Match(sCriteria, srg.Cells(r), 0)) = 0 Then

Answer 2

这可以很容易地完成，使用条件格式。我创建了以下规则：

=AND(A2<>"CBI",A2<>"Fire",A2<>"InCase",A2<>"LEA")

并将其应用于我的“B”列，如您在此屏幕截图中所见：

这是结果：

如何使用 Change(byVal Target as Range) to check/change 单元格颜色

How do I use Change(byVal Target as Range) to check/change cell color

excel

vba

range

byval

根据另一个单元格的值调整颜色