値がセル内にあるときのセルの色の変更

Question

私のメインシートには、長い16桁のコードを入力する列（列C）があります。次の列（列D）は、式「= MID（列Cのセル、16,6）」を有するコードの最後の6桁を引き出す。より長いコードの最後の6桁が、 Caseステートメントでは、列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（））を実行します。