Excel VBAでフォントの色が違うと OK・NGの出し方。

できますか？　できれば詳しく教えてください。お願いいたします。

質問者からの補足コメント

• 

  詳しく言えば、　A1かC1かD1が赤ければ　F1がNGとなるようなマクロを希望しています。
  よろしくお願いいたします。

    補足日時：2017/03/10 05:30

• 

  Sub OKNG_chk()
  Sheets("Sheet1").Select
  Dim j As String
  ’Dim j As Double
  
  For j = 1 To Cells(Column.Count, "D").End(xlUp).Row
  If Cells(j).Font.ColorIndex = 3 Then
  Range("E - 1") = "NG"
  Else
  Range("E - 2") = "OK"
  End If
  Next j
  End Sub
  
  さすがに上記はNGでした。

    補足日時：2017/03/10 06:48

• 

  Sub OKNG_chk()
  Sheets("Sheet1").Select
  
  Dim i As Double, j As Double
  For j = 0　To 3
  For i = ５To ５
  If Cells(j).Font.ColorIndex = 3 Then
  Cells(i) = "NG"
  End If
  Next i
  Next j
  
  End Sub
  上記でコンパイルは通ったんですがねw　さすがにまた上記はNGでした。

    補足日時：2017/03/10 07:22

No.3 回答者： WindFaller 回答日時： 2017/03/10 22:56

こんばんは。

A1かC1かD1なら、1 から　3となりませんが、必要に応じて修正してください。
この場合、ループのネストはややこしくなってしまいます。

'//
Sub OK_NG_Checking()
　Dim j As Long
　'A1かC1かD1が赤ければ　F1
　With Worksheets("Sheet1")
　　For j = 2 To .Cells(Rows.Count, 4).End(xlUp).Row
　　　If .Cells(j, 1).Font.ColorIndex = 3 Or _
　　　　.Cells(j, 3).Font.ColorIndex = 3 Or _
　　　　.Cells(j, 4).Font.ColorIndex = 3 Then
　　　　.Cells(j, 6).Value = "NG"
　　　　Else
　　　　.Cells(j, 6).Value = "OK"
　　　End If
　　Next j
　End With
End Sub

No.2 回答者： Zincer 回答日時： 2017/03/10 11:58

殆どできてますよ。

ちょっと修正すると
ーーーーーーーーーーーーーーーーーーー
Sub OKNG_chk()
’Sheets("Sheet1").Select←これいらない　
Sheets("Sheet1").Activate’←必要であればですけど、たぶんいらない！

Dim i As Double, j As Double
For j = 1　To 3’←セル指定に「０」はありません　列A～Cなら１～３
For i = １To ５’←セル指定に行１～５　
’For i = 1 To Cells(Column.Count, "D").End(xlUp).Row　’※D列の最終行までならこちらの方
If Cells(i,j).Font.ColorIndex = 3 Then　’セルの指定は、cells(行番号，列番号)
Cells(i,6) = "NG"　’６列目（＝F列）にNGを表示
End If
Next i
Next j
End Sub
ーーーーーーーーーーーーーーーーーーーー
たぶんこれでNGの表示まではできるはずです。
OK　を表示させるためにはもう一工夫必要です。

ーーーーーーーーーーーーーーーーーーー
Sub OKNG_chk()
Sheets("Sheet1").Activate’←必要であれば


Dim i As Double, j As Double
Dim CHK As Boolean '
For i = 1 To Cells(Column.Count, "D").End(xlUp).Row　
CHK=true　’　行番号が変われば初期化
For j = 1　To 3’列側の走査が内側
If Cells(i,j).Font.ColorIndex = 3 Then
CHK=false '１つでもあればNGを表示するために記録
End If
Next j

If CHK Then '１つもなければ
Cells(i,6) = "OK"　
Else
Cells(i,6) = "NG"　
End if

Next i
End Sub
ーーーーーーーーーーーーーーーーーーーー
これでいけませんか？確認してみてください。

No.1 回答者： t_fumiaki 回答日時： 2017/03/10 07:21

このコミュは半角字下げができないので、全角ブランクで字下げしています。

コピペしたら、半角に修正して下さい。


Sub WK()
Dim CNT As Long
Dim END1 As Long
Dim Sh As Worksheet

Set Sh = ActiveSheet
END1 = Sh.Range("A65536").End(xlUp).Row

For CNT = 2 To END1
　If Sh.Range("A" & CNT).Font.ColorIndex = 3 Or Sh.Range("C" & CNT).Font.ColorIndex = 3 Or Sh.Range("D" & CNT).Font.ColorIndex = 3 Then
　　Sh.Range("F" & CNT).Value = "OK"
　Else
　　Sh.Range("F" & CNT).Value = "NG"
　End If
Next CNT

Application.StatusBar = False
End Sub