Question

在我的主页中，我有一个列（C列），其中将输入一个长16位代码。下一列（列D）使用公式＆＃34; = MID（C列中的单元格，16,6和＃34;）导出该代码的最后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

Answer 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

Answer 2

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

当值在单元格

2 个答案: