行ごとに判定するマクロについて教えて下さい

質問

行ごとに判定するマクロについて教えて下さい。

下記のようなマクロで、添付ファイルのように、行ごとで
E列からN列で違った数値がないか、入力されていないセルがないかを調べ
４つすべてのセルが同じ数値でない場合は塗りつぶしはされず
O列にOKを表示しないようなマクロを組みたいのですが
現在のマクロだと、行ごとではなく、E3～N102セルまでの中で
同じ数値がないかを判断してしまっているため
K11セルやK15セルのように数値が入力されていないにも関わらずO列の部分にOKが出てしまいます。
他の行に同じ数値が入っているのは関係なしにして
11行目なら11行目だけで
15行目なら15行目だけで、というように行ごに判定していくには
どのようにすればいいでしょうか？

Sub 判定マクロ回転()
Dim i As Integer, j As Integer
Range(Cells(3, 15), Cells(102, 15)).ClearContents
For i = 3 To 102
For j = 5 To 14
Cells(i, j).Interior.ColorIndex = 0

If WorksheetFunction.CountIf(Range("E3:N102"), Cells(i, j)) > 3 Then
If Cells(i, j).Row Mod 2 = 1 Then
Cells(i, j).Interior.ColorIndex = 6
Cells(i, 15) = "OK"
Else
If Cells(i, j).Row Mod 2 = 0 Then
Cells(i, j).Interior.ColorIndex = 40
Cells(i, 15) = "OK"
End If
End If
End If

Next j
Next i
If WorksheetFunction.CountIf(Range("O3:O102"), "OK") > 99 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub

回答No.4

kkkkkm · ベストアンサー

偶数行と奇数行で色分けを忘れてました。たびたび訂正ですみません。

Sub example()
Dim i As Integer

Range(Cells(3, "O"), Cells(102, "O")).ClearContents
Range(Cells(3, "E"), Cells(102, "N")).Interior.ColorIndex = 0
For i = 3 To 102
If WorksheetFunction.CountIf(Range(Cells(i, "E"), Cells(i, "N")), Cells(i, "E")) > 3 Then
With Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K"), Cells(i, "N"))
If i Mod 2 = 1 Then
.Interior.ColorIndex = 6
Else
.Interior.ColorIndex = 40
End If
End With
Cells(i, "O") = "OK"
End If
Next

If WorksheetFunction.CountIf(Range("O3:O102"), "OK") > 99 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub

お礼

ご回答ありがとうございました。

希望通りのマクロになり大変勉強になりました。
何度も訂正、追加もして頂きありがとうございます。

今後ともよろしくお願いします。

回答No.3

kkkkkm

訂正
Range(Cells(3, "O"), Cells(102, "O")).Interior.ColorIndex = 0
↓
Range(Cells(3, "E"), Cells(102, "N")).Interior.ColorIndex = 0

でした。

回答No.2

kkkkkm

行全部を対象にするとまずい場合(E列からN列までを対象にする場合)
If WorksheetFunction.CountIf(Rows(i), Cells(i, "E")) > 3 Then
↓
If WorksheetFunction.CountIf(Range(Cells(i, "E"), Cells(i, "N")), Cells(i, "E")) > 3 Then
に変更してください。

回答No.1

kkkkkm

下記でいかがでしょう。

Sub example()
Dim i As Integer, j As Integer

Range(Cells(3, "O"), Cells(102, "O")).ClearContents
Range(Cells(3, "O"), Cells(102, "O")).Interior.ColorIndex = 0
For i = 3 To 102
If WorksheetFunction.CountIf(Rows(i), Cells(i, "E")) > 3 Then
Union(Cells(i, "E"), Cells(i, "H"), Cells(i, "K"), Cells(i, "N")).Interior.ColorIndex = 6
Cells(i, "O") = "OK"
End If
Next

If WorksheetFunction.CountIf(Range("O3:O102"), "OK") > 99 Then
MsgBox "データチェックOK(^O^)b"
End If
End Sub