当值在单元格中时更改单元格颜色答案

【问题标题】：Changing cell color when value is in cell当值在单元格中时更改单元格颜色
【发布时间】：2017-06-22 16:10:30
【问题描述】：

在我的主工作表中，我有一列（C 列），其中将输入一个长的 16 位代码。下一列（D 列）使用公式“=MID（C,16,6 列中的单元格”得出该代码的最后 6 位数字。如果较长代码的最后 6 位数字等于我列出的任何代码Case代码中的语句，F列对应的单元格应该变成红色，向用户表明F列的单元格需要一个代码。一旦F列单元格变成红色，用户就可以点击该单元格F 列，它将用户带到另一个代码列表。用户可以双击任何代码，它将在主工作表中填充 F 列。

到目前为止，当代码填充 F 列中的单元格时，它会变成无填充背景（如我所愿）但是，当我在任何同一行中的单元格，F 列中的单元格变回红色，代码仍在单元格中。我需要 F 列中的该单元格在输入数据后保持无填充背景，除非从单元格中删除代码，否则它可以变回红色以向用户指示该单元格需要一个值。当里面还有代码时，我就是不能让单元格变红。我觉得好像我有点接近，但我对 VBA 语法的了解不足以让这个功能正常工作。任何建议将不胜感激。

提前致谢。我会将代码发布到下面的主工作表/表格中：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

      Dim c As Range: Set c = Range("D7:D446")
      Dim d As Range: Set d = Range("F7:F446")

 For Each c In c.Cells
          Select Case c.Value
              Case "1000GP", "1000MM", "19FEST", "20IEDU", "20ONLC", "20PART", "20PRDV", "20SPPR", "22DANC", "22LFLC", "22MEDA", "530CCH", "60POUBL", "74GA01", "74GA17", "74GA99", "78REDV"
                  Cells(c.Row, "F").Interior.ColorIndex = 3
              Case Else
                 Cells(c.Row, "F").Interior.ColorIndex = 0
          End Select
      Next c
      If Not Application.Intersect(d, Range(Target.Address)) _
           Is Nothing Then
      Target.Interior.ColorIndex = 0

      End If

End Sub

【问题讨论】：

只有在 D 列而不是 F 列发生更改时，您的代码才会激活。
@UGP 非常感谢您的回答。那行得通。当我选择一个代码时，它现在填充 F 列中的单元格并将单元格变回无填充颜色。但是，当我从 F 列的单元格中删除该代码时，我希望 F 单元格变回红色。截至目前，它只是在删除时保持无填充背景颜色。你会碰巧知道我该怎么做吗？再次感谢！非常感谢。
我添加了一个简短的版本，您可能想看看。如果 F 中的值为 ""
@UGP 您的第一个答案中的第一个代码片段似乎效果最好。但是，在 F 列中的单元格变为白色后，当我在 D 列下方的行中添加另一个代码时，F 列中的单元格将变回红色。因此，如果我在单元格 F8 中添加了一个代码并且它变为白色，那么当我在单元格 D9 中添加一个不同的代码时，单元格 F8 将变回红色。我希望它保持白色，除非用户删除单元格 F8 中的代码，然后我才希望它变回红色。我会更新我的问题代码。感谢您迄今为止的帮助！
这种情况应该只发生在您开始使用的版本中。您在工作表上进行任何更改后检查 d 列中的每个单元格，并且不检查 f 列中的值，因此即使单元格中有值，它也会覆盖 f 列中的颜色。我的版本只会检查更改的单元格，但如果您愿意，我可以让它检查每个单元格。

标签： vba excel

【解决方案1】：

大概是这样的：

范围内的每个单元格：

    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim c As Range: Set c = Union(Range("D7:D446"), Range("F7:F446"))
    Dim CellF As Range, CellD As Range, Cell As Range

If Not Application.Intersect(c, Range(Target.Address)) _
           Is Nothing Then

    For Each Cell In c
        Set CellF = Range("F" & Cell.Row)
        Set CellD = Range("D" & Cell.Row)

        If CellF.Value <> "" Then
            CellF.Interior.ColorIndex = 0
        Else
            Select Case CellD.Value
            Case "1000", "1000MN", "19FET", "20IDU", "20ONC", "20RT", "20DV", "20SPPR", "22DC", "22LF", "22ME", "530H", "60UBL", "74G1", "74GA", "74A9", "78RV"
                    CellF.Interior.ColorIndex = 3
            Case Else
                CellF.Interior.ColorIndex = 0
            End Select
        End If
    Next Cell
End If
End Sub

仅更改单元格：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim c As Range: Set c = Union(Range("D7:D446"), Range("F7:F446"))
    Dim CellF As Range, CellD As Range, Cell As Range

If Not Application.Intersect(c, Range(Target.Address)) _
           Is Nothing Then

        Set CellF = Range("F" & Target.Row)
        Set CellD = Range("D" & Target.Row)

        If CellF.Value <> "" Then
            CellF.Interior.ColorIndex = 0
        Else
            Select Case CellD.Value
            Case "1000", "1000MN", "19FET", "20IDU", "20ONC", "20RT", "20DV", "20SPPR", "22DC", "22LF", "22ME", "530H", "60UBL", "74G1", "74GA", "74A9", "78RV"
                    CellF.Interior.ColorIndex = 3
            Case Else
                CellF.Interior.ColorIndex = 0
            End Select
        End If

End If
End Sub

【讨论】：

【解决方案2】：

我认为最简单的方法就是在 F 列上添加条件格式，这样如果单元格不为空，就没有填充。 This link 有更多关于如何做的信息，但你基本上是在条件格式框中做一个 NOT(ISBLANK()) 。

【讨论】：