Vba 值位于单元格中时更改单元格颜色

在我的主工作表中，我有一个C列，其中将输入一个长的16位代码。下一列D使用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

---

可能是这样的：

范围内的每个单元格：

    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

---

我认为最简单的方法就是在F列上添加条件格式，这样如果单元格不是空的，就不会有填充。有更多关于如何执行此操作的信息，但您基本上在条件格式框中执行NOTISBLANK操作。

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