複数のIf条件をvbaに追加する

Question

次のコードで特定のテキストをColpにチェックし、ColMの数値が> 1であることを確認します。一致する場合はCol Mの番号に色付けされます。

私はちょうどここに一つの条件を追加したい：-Additionally

それは数であれば、コルMをチェックし、言及した文字列のコルPをチェックし一致した場合、テキスト「失敗」のコルOをチェックCOL Mが> 3の場合、読み込みで色を付けるか（Col Pに文字列がある場合のみ）、それ以外の場合は色付けしないでください。 Select Case（私の好み）の前に、新しい行に：

オプション1：

Sub Test() 
    Dim r As Long, LastRow As Long 
    Dim RemainingDay As Double '<--| 

    With Worksheets("Latency") '<--| reference worksheet "Latency" 
     LastRow = .Cells(.Rows.Count, "A").End(xlUp).row '<--| get row index of its column A last not empty cell 
     Application.ScreenUpdating = False 
     For r = 2 To LastRow 
      RemainingDay = 0 '<--| 

      If Weekday(.Range("K" & r).value, vbSaturday) > 2 Then '<--| having 'Weekday()' function starting from "Saturday", 
       Select Case True 
        Case InStr(.Range("P" & r).text, "Moved to SA (Compatibility Reduction)") > 0, _ 
         InStr(.Range("P" & r).text, "Moved to SA (Failure)") > 0, _ 
         InStr(Range("P" & r).text, "Gold framing") > 0 
         If .Range("M" & r) - RemainingDay >= 1 Then 
          .Range("M" & r).Cells.Font.ColorIndex = 3 
         Else 
          .Range("M" & r).Cells.Font.ColorIndex = 0 
         End If 
       End Select 
      End If 
     Next r 
    End With 
End Sub 

Answer 1

新しいIf 2のオプションを追加することができます。

Sub Test() 
    Dim r As Long, LastRow As Long 
    Dim RemainingDay As Double '<--| 

    With Worksheets("Latency") '<--| reference worksheet "Latency" 
     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<--| get row index of its column A last not empty cell 
     Application.ScreenUpdating = False 
     For r = 2 To LastRow 
      RemainingDay = 0 '<--| 

      If Weekday(.Range("K" & r).Value, vbSaturday) > 2 Then '<--| having 'Weekday()' function starting from "Saturday", 
       If .Range("o" & r).Value Like "Fail" Then '<-- ****** add the If here ****** 
        Select Case True 
         Case InStr(.Range("P" & r).Text, "Moved to SA (Compatibility Reduction)") > 0, _ 
          InStr(.Range("P" & r).Text, "Moved to SA (Failure)") > 0, _ 
          InStr(Range("P" & r).Text, "Gold framing") > 0 
          If .Range("M" & r) - RemainingDay >= 1 Then 
           .Range("M" & r).Cells.Font.ColorIndex = 3 
          Else 
           .Range("M" & r).Cells.Font.ColorIndex = 0 
          End If 
        End Select 
       End If 
      End If 
     Next r 
    End With 
End Sub 

オプション2：And

Sub Test() 
    Dim r As Long, LastRow As Long 
    Dim RemainingDay As Double '<--| 

    With Worksheets("Latency") '<--| reference worksheet "Latency" 
     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<--| get row index of its column A last not empty cell 
     Application.ScreenUpdating = False 
     For r = 2 To LastRow 
      RemainingDay = 0 '<--| 

      ' ****** add the extra if at the line below with an And ***** 
      If Weekday(.Range("K" & r).Value, vbSaturday) > 2 And .Range("o" & r).Value Like "Fail" Then '<--| having 'Weekday()' function starting from "Saturday", 
       Select Case True 
        Case InStr(.Range("P" & r).Text, "Moved to SA (Compatibility Reduction)") > 0, _ 
         InStr(.Range("P" & r).Text, "Moved to SA (Failure)") > 0, _ 
         InStr(Range("P" & r).Text, "Gold framing") > 0 
         If .Range("M" & r) - RemainingDay >= 1 Then 
          .Range("M" & r).Cells.Font.ColorIndex = 3 
         Else 
          .Range("M" & r).Cells.Font.ColorIndex = 0 
         End If 
       End Select 
      End If 
     Next r 
    End With 
End Sub 

を使用して、その中に Ifで既存の行に追加します