1

我的主要数据输入是一个名为“主”的工作表。我想在输入单词时检查 Range A2:A1000。如果它是“CBI”、“Fire”、“InCase”或“LEA”，则不需要在 I 列（偏移量（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”中查看了 stackoverflow 结果，并尝试修改但没有成功。我还在单独的模块中尝试了几次编码尝试，我的其他 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
4

2 回答 2

0

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

  • I这将根据在 column 中手动输入的值（不是通过公式）调整 column 中单元格的颜色A。如果列A不包含列表中的值，则列的同一行中的单元格I将被着色。
  • 如果您已经在 column 中有值A，您可以简单地选择它们并执行“复制/粘贴”，并且 column 中的颜色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
于 2021-12-21T13:02:48.317 回答
0

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

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

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

在此处输入图像描述

这是结果：

在此处输入图像描述

于 2021-12-21T14:07:25.420 回答