[[20180202112039]]　『マクロ　もう少し簡便にまとめたい』（宇都会ね）　ページの最後に飛ぶ

『マクロ　もう少し簡便にまとめたい』（宇都会ね）

次のことも合わせてできないものか、お伺い致します。

１．先頭の部分でエラーの黄色が表示しています。解消ができないので解消したい
２．If Cells(i, "H") >= 1 And Cells(i, "H") < 50 Then
Cells(i, "H").Interior.ColorIndex = 38 '38はピンク　　合計

ピンクにはできますが、条件が多すぎて５０以下で"補"にできませんが、どのようにしたらよいかもお教え頂けませんか。

Sub TestResult()

 Dim i As Long, LastRow As Long

 LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("J2:J" & LastRow).ClearContents

 Range("E2:J" & LastRow).Interior.ColorIndex = 0

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 For i = 2 To LastRow
If (Cells(i, "E") = "" Or Cells(i, "F") = "") Or Cells(i, "G") = "" Then 
Cells(i, "J") = "外"
ElseIf (Cells(i, "E") = "" Or Cells(i, "F") = "") Or Cells(i, "G") = "" Then 
Cells(i, "J") = "外"
ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") >= 6) And Cells(i, "G") >= 10 Then 
Cells(i, "J") = "正"
ElseIf ((Cells(i, "E") >= 20 And Cells(i, "F") >= 10) And Cells(i, "G") >= 1) And Cells(i, "G") <= 10 Then 
Cells(i, "J") = "正"
ElseIf Cells(i, "H") >= 1 And Cells(i, "H") < 48 Then 
Cells(i, "J") = "補"
ElseIf (Cells(i, "E") = 0 Or Cells(i, "F") = 0) Or Cells(i, "G") = 0 Then 
Cells(i, "J") = "補"
ElseIf (Cells(i, "E") <= 19 And Cells(i, "F") >= 6) And Cells(i, "G") >= 10 Then
Cells(i, "J") = "補"
ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") <= 9) And Cells(i, "G") >= 10 Then 
Cells(i, "J") = "補"
ElseIf Cells(i, "Ｇ") >= 1 And Cells(i, "Ｇ") < 10 Then 
Cells(i, "J") = "補"
ElseIf (Cells(i, "E") <= 9 And Cells(i, "F") >= 5) And Cells(i, "G") >= 9 Then 
Cells(i, "J") = "補"
ElseIf (Cells(i, "E") >= 9 And Cells(i, "F") <= 5) And Cells(i, "G") >= 10 Then 
Cells(i, "J") = "補"
ElseIf (Cells(i, "E") <= 9 And Cells(i, "F") >= 5) And Cells(i, "G") >= 9 Then 
Cells(i, "J") = "補"
ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") <= 5) And Cells(i, "G") >= 9 Then 
Cells(i, "J") = "補"
ElseIf (Cells(i, "E") <= 19 And Cells(i, "F") <= 5) And Cells(i, "G") <= 9 Then 
Cells(i, "J") = "補"
ElseIf ((Cells(i, "E") <= 19 And Cells(i, "F") >= 5) And Cells(i, "G") >= 1) And Cells(i, "G") <= 9 Then 
Cells(i, "J") = "補"
End If

If Cells(i, "E") = 0 Then

 Cells(i, "E").Interior.ColorIndex = 3
End If
If Cells(i, "F") = 0 Then
 Cells(i, "F").Interior.ColorIndex = 3
End If
If Cells(i, "G") = 0 Then
 Cells(i, "G").Interior.ColorIndex = 3
End If
If Cells(i, "E") >= 1 And Cells(i, "E") < 20 Then
 Cells(i, "E").Interior.ColorIndex = 6 '6は黄色  走
End If
If Cells(i, "Ｆ") >= 1 And Cells(i, "Ｆ") < 6 Then
 Cells(i, "Ｆ").Interior.ColorIndex = 6 '6は黄色　攻
End If
If Cells(i, "Ｆ") >= 6 And Cells(i, "Ｆ") < 10 Then
 Cells(i, "Ｆ").Interior.ColorIndex = 34 '20は淡い青色　攻
End If
If Cells(i, "Ｇ") >= 1 And Cells(i, "Ｇ") < 10 Then
 Cells(i, "Ｇ").Interior.ColorIndex = 6 '6は黄色　　守
End If
If Cells(i, "H") >= 1 And Cells(i, "H") < 50 Then
 Cells(i, "H").Interior.ColorIndex = 38 '38はピンク　　合計
End If
If Cells(i, "J") >= "欠" Then
 Cells(i, "J").Interior.ColorIndex = 46 '46は薄いオレンジ
End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "E").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "F").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "G").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "H").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "I").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If

Next i

 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

 End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

すごく見づらいので、全部よみこめてないですが、比較条件の元となるものが一緒なら　ElseIFでネストさせるんじゃなくて、Select　Case　使った方がやりやすいんじゃないですか？
（もこな２） 2018/02/02(金) 11:44

次の条件を付けるのを忘れてました

                    正                       走      攻      守     合計
合格基準　ボーダー　　                          20       6      10     36

守の基準に達しない 20 10 9 39

                     補                       走      攻      守     合計
走の基準に達しない                              19       6      10     35
攻の基準に達しない                              20       4      10     34

走・攻・守の３つが１桁である　　　　　　　　　　9 　　　 6 　　 9　　 24

走・攻の２つが１桁である　　　　　　　　　　　　 9 　　　 6 　　 10 　 25

走・守の２つが１桁である　　　　　　　　　　　　 9 　　　 10 　　 9 　 28

　
攻・守の２つが１桁である　　　　　　　　　　　　 20 　　　 6 　　 9 　 35

（ウルトラ１５） 2018/02/02(金) 12:49

条件抜けがボロボロありそうで、まともに追いかける気になりません。
以下のようにコーディングし、抜けが無いように最初から考え直してはいかがでしょうか？

    Select Case Cells(i, "E").Value
    Case ""
        Cells(i, "J").Value = "外"
    Case 0
        Cells(i, "J").Value = "補"
    Case Is < 10
        Select Case Cells(i, "F").Value
        Case ""
        Case 0
        Case Is < 5
        Case Is < 10
        Case Else
        End Select
    Case Is < 20
    Case Else
    End Select
（???） 2018/02/02(金) 13:40

投稿者と追加情報を出してる方が違いますが、同じ方でしょうか？

とりあえず???さんも指摘されますが、もう一度条件をご自身でよく練り直した方がよいかも。
以下、???さんのコメントを拝見する前にメモ帳で書いていたものです。直すの面倒なのでそのまま投稿します。

私の読み間違えでなければ最初のIFを整理すると、
(01) E = "" Or F = " Or G = "" Then J = "外"
(02) E = "" Or F = " Or G = "" Then J = "外"
(03) E >= 20 And F >= 6 And G >= 10 Then J = "正"
(04) E >= 20 And F >= 10 And G >= 1 And G <= 10 Then J = "正"
(05) H >= 1 And H < 48 Then J = "補"
(06) E = 0 Or F = 0) Or G = 0 Then J = "補"
(07) E <= 19 And F >= 6 And G >= 10 Then J = "補"
(08) E >= 20 And F <= 9 And G >= 10 Then J = "補"
(09) Ｇ >= 1 And Ｇ < 10 Then J = "補"
(10) E <= 9 And F >= 5 And G >= 9 Then J = "補"
(11) E >= 9 And F <= 5 And G >= 10 Then J = "補"
(12) E <= 9 And F >= 5 And G >= 9 Then J = "補"
(13) E >= 20 And F <= 5 And G >= 9 Then J = "補"
(14) E <= 19 And F <= 5 And G <= 9 Then J = "補"
(15) E <= 19 And F >= 5 And G >= 1 And G <= 9 Then J = "補"
だとおもうんですが、これを、さらに整理すると

【例外グループ】
(01) E = "" Or F = " Or G = "" Then J = "外"
(02) E = "" Or F = " Or G = "" Then J = "外"
(06) E = 0 Or F = 0 Or G = 0 Then J = "補"
(05) H >= 1 And H < 48 Then J = "補"
(09) Ｇ >= 1 And Ｇ < 10 Then J = "補"

【E >= 20　のグループ】
(03) E >= 20 And F >= 6 And G >= 10 Then J = "正"
(04) E >= 20 And F >= 10 And G >= 1 And G <= 10 Then J = "正"
(08) E >= 20 And F <= 9 And G >= 10 Then J = "補"
(13) E >= 20 And F <= 5 And G >= 9 Then J = "補"

【E <= 9　のグループ】
(10) E <= 9 And F >= 5 And G >= 9 Then J = "補"
(12) E <= 9 And F >= 5 And G >= 9 Then J = "補"

【E >= 9　のグループ】
(11) E >= 9 And F <= 5 And G >= 10 Then J = "補"

【E <= 19　のグループ】
(07) E <= 19 And F >= 6 And G >= 10 Then J = "補"
(14) E <= 19 And F <= 5 And G <= 9 Then J = "補"
(15) E <= 19 And F >= 5 And G >= 1 And G <= 9 Then J = "補"
って分けられるかとおもいます。

で、これをみると、（１）と（２）、（１０）と（１２）は重複してるように思います。
また、全体で以上、以下となるように組んでいるので、しきい値ちょうどのものはどっちに振り分けたいのでしょうか？

とりあえず、見やすさの観点から
Select　case E列の値

    case >= 20
        (03)    F >= 6 And G >= 10 Then J = "正"
        (04)    F >= 10 And G >= 1 And G <= 10 Then J = "正"
        (08)    F <= 9 And G >= 10 Then J = "補"
        (13) F <= 5 And G >= 9 Then J = "補"
　　　　　・
　　　　　・
　　　　　・
って直していったらどうでしょうか？
（もこな２） 2018/02/02(金) 14:18

最初のIf文と条件見てると

E,F列が条件を満たしてるなら「正」、
E,F,G列のいずれかが空なら「外」、
それ以外なら「補」みたいなんだが

それで間違いないならこれで動きませんかね？

 Dim columnECell As Variant
 Dim columnFCell As Variant
 Dim columnGCell As Variant

 columnECell = Cells(i, "E").Value
 columnFCell = Cells(i, "F").Value
 columnGCell = Cells(i, "G").Value

 Select Case True
 Case columnECell > 20 And columnFCell >= 6
     Cells(i, "J").Value = "正"
 Case columnECell = "", columnFCell = "", columnGCell = ""
     Cells(i, "J").Value = "外"
 Case Else
     Cells(i, "J").Value = "補"
 End Select

（y） 2018/02/02(金) 19:29

下記の２つがエラーになります
columnECell = Cells(i, "E").Value
Sub TestResult()

Sub TestResult()

 Dim i As Long, LastRow As Long

 LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("J2:J" & LastRow).ClearContents

 Range("E2:J" & LastRow).Interior.ColorIndex = 0

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 Dim columnECell As Variant
 Dim columnFCell As Variant
 Dim columnGCell As Variant

 columnECell = Cells(i, "E").Value
 columnFCell = Cells(i, "F").Value
 columnGCell = Cells(i, "G").Value

 Select Case True
 Case columnECell > 20 And columnFCell >= 6
     Cells(i, "J").Value = "正"
 Case columnECell = "", columnFCell = "", columnGCell = ""
     Cells(i, "J").Value = "外"
 Case Else
     Cells(i, "J").Value = "補"
 End Select

If Cells(i, "E") = 0 Then

 Cells(i, "E").Interior.ColorIndex = 3
End If
If Cells(i, "F") = 0 Then
 Cells(i, "F").Interior.ColorIndex = 3
End If
If Cells(i, "G") = 0 Then
 Cells(i, "G").Interior.ColorIndex = 3
End If
If Cells(i, "E") >= 1 And Cells(i, "E") < 20 Then
 Cells(i, "E").Interior.ColorIndex = 6 '6は黄色  走
End If
If Cells(i, "Ｆ") >= 1 And Cells(i, "Ｆ") < 6 Then
 Cells(i, "Ｆ").Interior.ColorIndex = 6 '6は黄色　攻
End If
If Cells(i, "Ｆ") >= 6 And Cells(i, "Ｆ") < 10 Then
 Cells(i, "Ｆ").Interior.ColorIndex = 34 '20は淡い青色　攻
End If
If Cells(i, "Ｇ") >= 1 And Cells(i, "Ｇ") < 10 Then
 Cells(i, "Ｇ").Interior.ColorIndex = 6 '6は黄色　　守
End If
If Cells(i, "H") >= 1 And Cells(i, "H") < 50 Then
 Cells(i, "H").Interior.ColorIndex = 38 '38はピンク　　合計
End If
If Cells(i, "J") >= "欠" Then
 Cells(i, "J").Interior.ColorIndex = 46 '46は薄いオレンジ
End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "E").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "F").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "G").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "H").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "I").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If

Next i

 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

 End Sub

（宇土会ね） 2018/02/02(金) 22:10

それはそうだろうね

for文はどこいった？

columnECell = Cells(i, "E").Valueの行で
エラー番号１００４になったのかなと思ったが、
実行以前のコンパイルエラーじゃないか

動いたとしても、i as long で値が設定されてないから i は 0 だし
その場合 Cells(i, "E").Value は Cells(0, "E").Value となる
"E0"と言うセルは存在しないから、結局エラーになる
（y） 2018/02/03(土) 01:02

1）繰り返しの部分は後でどうでもなるので、まずは判定部分を作る（chk正補判定のプロシージャ）
2）まず、判定の例外の条件を判断し、例外のデータならさっさと判定を抜ける
（今回は、「空白データが含まれる」場合と言えるのかな？）
3）正か補かどちらかに注目して判定する。

あれとこれとそれと、、、って考えるとややこしいので、
AndやOrでできれば繋がない。
例えば、正にならない場合を羅列していく。
つまり、
どのIFにも引っかからなかったら正とする。
複数の条件に該当してもどうせ補なら気にしない。
しかし、上から順に実行されるので、
判断する項目の順番は重要

そして、どの条件にも該当しなければ正となる。

そのように考えたら、表現が簡単にならないでしょうか？

Sub test()

    Dim Rng As Range
    Dim r As Range
    Dim ixCollar As Long

    Set Rng = Range(Range("A2"), Cells(Rows.Count, "A").End(xlUp)) _
              .Offset(, 4).Resize(, 5)

    For Each r In Rng.Rows
        r(1, r.Columns.Count + 1).Value = chk正補判定(r)
    Next
End Sub

Function chk正補判定(ByVal rng走攻守 As Range) As String

    Dim v As Variant

    chk正補判定 = "正"

    If WorksheetFunction.CountBlank(rng走攻守) Then
        chk正補判定 = "外"           '空白があれば判定から除外
        rng走攻守.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 46
        Exit Function
    End If

    With Rng.Cells(1)
    If .Value < 20 Then chk正補判定 = "補"          '走基準
        .Interior.ColorIndex = 6
    End With

    With Rng.Cells(2)
        If .Value < 6 Then chk正補判定 = "補"           '攻基準
        .Interior.ColorIndex = 6
    End With

    With Rng.Cells(3)
        If .Value < 10 Then chk正補判定 = "補"          '守基準
        .Interior.ColorIndex = 6
    End With

    With Rng.Cells(4)
        If .Value < 50 Then chk正補判定 = "補"          '合計が50未満
        .Interior.ColorIndex = 38
    End With

    If WorksheetFunction.CountIf(rng走攻守, "<10") > 1 Then chk正補判定 = "補"  '１桁の数値が2つ以上
End Function

（まっつわん） 2018/02/03(土) 09:48

（まっつわん）さん有難うございます。下記のものがエラーになります。
どのように修正したらよいでしょうか、お教え下さいませんか、よろしくお願いします。

With Rng.Cells(1)
（宇土会ね） 2018/02/03(土) 10:51

（宇土会ね） 2018/02/03(土) 10:51の記載忘れがありましたので追加しておきます。

「オブジェクトが必要です」とエラーメッセージです、申し訳ありません。
（宇土会ね） 2018/02/03(土) 10:58

IF文条件がどこまで正しいか分からなくなってきた・・・

 ElseIf Cells(i, "H") >= 1 And Cells(i, "H") < 48 Then 
 Cells(i, "J") = "補"

 If Cells(i, "H") >= 1 And Cells(i, "H") < 50 Then
  Cells(i, "H").Interior.ColorIndex = 38 '38はピンク　　合計
 End If

上限が異なるけど、これどっちが正しいの？
どちらも正しいのかもしれないですけど

 If Cells(i, "J") >= "欠" Then

"欠"は正しいとしても、不等号を入れた意味は何だろう
そもそも"欠"がこの時点で残っているのかな？
初期値でもないようだから、手入力？

同じ判定を複数回させるなら、１回にまとめませんか？

 If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "E").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
 （略）
 If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
 Cells(i, "I").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If

Cellsの列指定が全角半角入り混じってるのは何でだろう

こちらのミスもあったことだし、一応修正＋後半部追加

 Sub Macro1()
 '
 ' Macro1 Macro
 '

 '
 LastRow = Cells(Rows.Count, "G").End(xlUp).Row
 Range("E2:J" & LastRow).Interior.ColorIndex = 0

 For i = 2 To LastRow

    columnECell = Cells(i, "E").Value
    columnFCell = Cells(i, "F").Value
    columnGCell = Cells(i, "G").Value
    columnHCell = Cells(i, "H").Value

    Select Case True
    Case columnECell = "", columnFCell = "", columnGCell = ""
        Cells(i, "J").Value = "外"
    Case columnECell >= 20 And columnFCell >= 6
        Cells(i, "J").Value = "正"
    Case Else
        Cells(i, "J").Value = "補"
    End Select

    Select Case columnECell
    Case 0
        Cells(i, "E").Interior.ColorIndex = 3
    Case Is < 20
        Cells(i, "E").Interior.ColorIndex = 6 '6は黄色  走
    End Select

    Select Case columnFCell
    Case 0
        Cells(i, "F").Interior.ColorIndex = 3
    Case Is < 6
        Cells(i, "Ｆ").Interior.ColorIndex = 6 '6は黄色　攻
    Case Is < 10
        Cells(i, "Ｆ").Interior.ColorIndex = 34 '20は淡い青色　攻
    End Select

    Select Case columnGCell
    Case 0
        Cells(i, "G").Interior.ColorIndex = 3
    Case Is < 10
        Cells(i, "Ｇ").Interior.ColorIndex = 6 '6は黄色　　守
    End Select

    Select Case columnHCell
    Case 1 To 49
        Cells(i, "H").Interior.ColorIndex = 38 '38はピンク　　合計
    End Select

    If Cells(i, "J") >= "欠" Then
        Cells(i, "J").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If

    If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
        Range("E" & i & ":I" & i).Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
 Next
 End Sub

With Rng.Cells(1)はWith rng走攻守.Cells(1)の間違いなんだろうか・・・？
（y） 2018/02/03(土) 11:16

（y）さん 2018/02/03(土) 11:16
もうしわけありません。初心者で再三ご迷惑をお掛けしています、恐縮です。
疑問点の回答をと思い送信しました。

If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then

 Cells(i, "E").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
重複しています、削除します。

If Cells(i, "H") >= 1 And Cells(i, "H") < 50 Then こちらが正しいです。

If Cells(i, "J") >= "欠" Then If Cells(i, "J") >= "外" Thenの間違いでした

それと

With rng走攻守.Cells(1)に変えたらエラーは消えましたが、

新たに
r(1, r.Columns.Count + 1).Value = chk正補判定(r)のエラーになり
「アプリケーション定義またはオブジェクト定義エラーです」と出ました。

（宇土会ね） 2018/02/03(土) 11:45

なんだかよくわからないけど、

 r.Cells(1, r.Columns.Count + 1).Value = chk正補判定(r)

でとりあえず動くみたいです
動かなかったらすまん
（y） 2018/02/03(土) 12:45

（y）さん 2018/02/03(土) 11:16
　E列～H列は条件どおりに出来ました。
　しかし、J列の色つけについて、条件を踏まえて正と補のところが「正」は色無し、「補」は黄色になっていません。また「外」は空欄になりますので、「46は薄いオレンジ」E列からJ列の全てがそのようにしたいのですが
、どこを修正したら良いでしょうか。

Sub Test()

 Dim i As Long, LastRow As Long

 LastRow = Cells(Rows.Count, "G").End(xlUp).Row
 Range("E2:J" & LastRow).Interior.ColorIndex = 0

 For i = 2 To LastRow

    columnECell = Cells(i, "E").Value
    columnFCell = Cells(i, "F").Value
    columnGCell = Cells(i, "G").Value
    columnHCell = Cells(i, "H").Value

    Select Case True
    Case columnECell = "", columnFCell = "", columnGCell = ""
        Cells(i, "J").Value = "外"
    Case columnECell >= 20 And columnFCell >= 6
        Cells(i, "J").Value = "正"
    Case Else
        Cells(i, "J").Value = "補"
    End Select

    Select Case columnECell
    Case 0
        Cells(i, "E").Interior.ColorIndex = 3
    Case Is < 20
        Cells(i, "E").Interior.ColorIndex = 6 '6は黄色  走
    End Select

    Select Case columnFCell
    Case 0
        Cells(i, "F").Interior.ColorIndex = 3
    Case Is < 6
        Cells(i, "Ｆ").Interior.ColorIndex = 6 '6は黄色　攻
    Case Is < 10
        Cells(i, "Ｆ").Interior.ColorIndex = 34 '20は淡い青色　攻
    End Select

    Select Case columnGCell
    Case 0
        Cells(i, "G").Interior.ColorIndex = 3
    Case Is < 10
        Cells(i, "Ｇ").Interior.ColorIndex = 6 '6は黄色　　守
    End Select

    Select Case columnHCell
    Case 1 To 49
        Cells(i, "H").Interior.ColorIndex = 38 '38はピンク　　合計
    End Select

    If Cells(i, "J") >= "外" Then
        Cells(i, "J").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If

    If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
        Range("E" & i & ":I" & i).Interior.ColorIndex = 46 '46は薄いオレンジ
    End If

Next i

 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

 End Sub

（宇土会ね） 2018/02/03(土) 13:20

J列の色指定？
見落としが無ければ

 If Cells(i, "J") >= "欠" Then
  Cells(i, "J").Interior.ColorIndex = 46 '46は薄いオレンジ
 End If

しかなかったような

確認ですが、J列条件は次の通りになるのですね
「正」：色無し
「補」：黄色
「外」：薄いオレンジ（E列からJ列全て）

この２つのIF文は「薄いオレンジ」しか色指定がありません
（「補」：黄色に対しては分岐・色付け処理そのものがありません）

    If Cells(i, "J") >= "外" Then
        Cells(i, "J").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If

    If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
        Range("E" & i & ":I" & i).Interior.ColorIndex = 46 '46は薄いオレンジ
    End If

また、Cells(i, "J") >= "外" はE,F,G列のいずれかが空の場合、
WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 はE列からI列までの全てが空の場合
と条件が異なります

したがって、どこを修正したら良いかとの質問ならこの２つの条件文になります

（y） 2018/02/03(土) 17:28

完成できました。色な方にお世話になりました。特に（y）さんには、丁寧にご回答下さりありがとうございました。今後ともよろしくお願いいたします。
（宇土会ね） 2018/02/03(土) 20:48

コメント返信：

[ 一覧(最新更新順) ]

[[20180202112039]] 『マクロ もう少し簡便にまとめたい』（宇都会ね） ページの最後に飛ぶ

[[20180202112039]]　『マクロ　もう少し簡便にまとめたい』（宇都会ね）　ページの最後に飛ぶ