『Excel　マクロ　特定の数字を赤にする』（ウルトラ） A B C D E F G H I J K L 1 科目名 2 学級 3 担任名 4 学科名 5 学期 6 氏名 得点 得点 訂正 付加点 得点 訂正 付加点 付加点 合計 平均 評定 7 生徒1 66 80 85 12 45 48 18 18 208 60.8 4 8 生徒2 18 18 　 6 46 　 6 14 58 14.0 3 9 生徒3 75 75 15 47 　 3 20 65 55.0 3 10 生徒4 44 42 48 18 23 12 11 101 38.0 3 11 生徒5 77 77 　　 6 49 50 18 15 123 53.3 2 12 生徒6 32 29 　　 3 29 35 14 23 81 21.3 1 13 生徒7 94 94 　　 12 28 20 11 60 66.7 3 14 生徒8 22 22 25 18 29 11 15 83 21.8 2 15 生徒9 15 15 　 14 55 52 15 23 136 14.7 3 16 生徒10 66 5 8 20 56 59 23 2 166 24.8 3 　 不用 不用 不用 不用 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer If Target.Count > 1 Then Exit Sub If Target.Column < 0 Then Exit Sub Select Case Target.Value Case 0 To 29 myColor = 3 '赤色 Case 30 To 100 myColor = 1 '黒色 Case Else myColor = xlNone End Select Target.Font.ColorIndex = myColor End Sub 上記のような、レイアウトの表があります。ネットで２９以下の数字を赤にするコードを見つけてやってみました。 If Target.Column < 0 Then Exit Sub　 この部分を＜０にすることで、全てのセルに該当して赤（２９以下）になったのですが、ここで問題がおきました。不用な列まで、該当していることに気づきました。 「不用」のとこをはずして表示するにはどのように修正したらよいのか、教えて下さいませんか。７行目から該当箇所になります。 また、１〜６行目に文言を記入すると、エラーのようなことがおこります。修正できるとよいのですが。 それに、今後列を増やしたり、行を増やしたりすることも出てきそうですので、範囲などは出来るだけ「A2:G6,I9:L15」とかを使って頂くと修正がしやすいと思いますが、如何なものでしょうか。取りあえずは、上限の列は２５列程度、行は５０行程度が上限かと思います。よろしくお願いします。 ＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞ ---- 参考になりますか https://www.moug.net/tech/exvba/0050131.html （マナ） 2016/05/20(金) 23:17 ---- 色を付けたい列は、どことどこですか？ （β） 2016/05/20(金) 23:43 ---- おはようございます。 マクロでしたい理由があるんですか？ 条件付き書式なら、シート全体を選択して、条件付き書式の数式で =AND(A$6<>"付加点",A$6<>"評定",A1<30) とするだけですけど。 行や列の増減は自由ですし、6行目の項目名で判断して外したい項目名を設定するだけです。 （sy） 2016/05/21(土) 08:08 ---- 6行目より上に数値が入る可能性があるなら、 =AND(A$6<>"付加点",A$6<>"評定",A1<30,ROW()>6) として7行目以降だけを対象にすれば良いです。 （sy） 2016/05/21(土) 08:15 ---- syさんと同様に感じました。 対象となる領域を限定したいなら　行が●●以上とか、列はこうだという条件を式の中で指定すればいいわけですので。 そもそも　If Target.Column < 0 Then Exit Sub エクセル上のセル、どこが変更になったとしても、列番号は　1 以上ですから、 < 0 ということはない。 つまり、無条件実施というコードになっています。 （β） 2016/05/21(土) 08:31 ---- 皆さんありがとございます。 >色を付けたい列は、どことどこですか？ B,C,D,F,G,J,K,M,N,O,Q,R,U,V,X,Y,AB,AC列になります。 　　但し、上限の列は２５〜３０列程度、行は５０行程度が上限かと思います。 ＞参考になりますか 　　これを参考にして、下記のようにやってみましたが、うまくいきませんでした。B,C列はできましたが、なぜかD列はできませんでした。 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("B7:D17")) Is Nothing Then Exit Sub End If Select Case Target.Value Case 0 To 29 myColor = 3 '赤色 Case 30 To 100 myColor = 1 '緑色 Case Else myColor = xlNone End Select Target.Font.ColorIndex = myColor End Sub ＞条件付き書式なら、シート全体を選択して、条件付き書式の数式で 　　　実は、条件付き書式でやってみましたが、やり方が悪くて単独の列しかできず、マクロではと想ったわけです。 　 　やってみて、結果を連絡したいと想います。 （ウルトラ） 2016/05/21(土) 08:55 ---- xlNoneではなく、xlAutomaticではないでしょうか （マナ） 2016/05/21(土) 10:45 ---- xlNone で間違いない、しいて言うならxlColorIndexNoneの方が正解かも知れない。 ただ、どちらも同じ値だが。 （とおりすがり） 2016/05/21(土) 11:05 ---- 失礼します。 対象が Font ですから　xlAutomatic ではないでしょうか？ Font の場合、xlNone をセットすると、『何もセットしない』ということになるようです。 Sub test() Range("A1:A2").Font.ColorIndex = 3 Range("A1").Font.ColorIndex = xlAutomatic Range("A2").Font.ColorIndex = xlNone End Sub （β） 2016/05/21(土) 11:53 ---- K列実数なので 29< 設定　<30 が myColor = xlNone　　になるけど （ABC1955） 2016/05/21(土) 12:27 ---- 今のマクロでの方法では ABC1955さんのK列が全て、myColor = xlNone　になると言うのもありますし、 合計や平均は関数で求めてるんじゃ無いんですか？ Worksheet_Changeだと関数で変化した結果には色が付かないですよ。 マクロで行うなら根本から見直す必要があります。 （sy） 2016/05/21(土) 13:26 ---- >対象が Font ですから　xlAutomatic ではないでしょうか？ 失礼した。とんだ思い違いをしていたようだ。m(..)m （とおりすがり） 2016/05/21(土) 15:19 ---- とりあえず、マクロを使わず、条件付書式で対処する案です。 （すでに、syさんからあった回答に、その後、説明された列条件を加えただけです） ・B,C,D,F,G,J,K,M,N,O,Q,R,U,V,X,Y,AB,AC　列をすべて選択します。 ・この状態で　条件付書式　数式が　=AND(ROW()>7,B1<30)　書式で文字色を赤。 これだけです。 （β） 2016/05/21(土) 22:44 ---- To βさん 列を選択して列単位で条件付き書式をセットするのも良いんですけど、この場合列に変化があった時に、列数が多いと範囲の修正がめんどくさいので、 範囲はシート全体で、式中の条件で不要な項目名を対象外にする方が列の変動には対応しやすいと思います。 私の方法では、そう言う方向性で書いてます。 （sy） 2016/05/21(土) 22:56 ---- To syさん なるほどですね。 不要な項目名を判定するか、あるいは、必要な項目名を判定するか、そのあたりは、実態として、どちらが やりやすいか、ウルトラさんの判断でやられたらよろしいですね。 To ウルトラさん ところで、（条件付書式での対応がよろしいかとは思いますが）仮に Worksheet_Change で対応する場合。 処理しやすいように、まず　If Target.Count > 1 Then Exit Sub　。 悪くはないように思われますが、たとえば　複数行、同じ数字だった場合に、１セルだけ入力して あとは　フィルコピーする場合があれば、この Target.Count は 2以上になりますので処理されません。 もし、それが 30未満の数字だった場合、シート上には 30未満の数字があるのに着色されないということになります。 どこかの複数セル領域と同じ数字だった場合に、その複数セル領域をコピーして、貼り付けた場合も同様の状況になります。 （β） 2016/05/21(土) 23:17 ---- 無条件に、変更した行の色を再設定していますが その分、コードが簡単になります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer Dim r As Range Dim c As Range Set r = Intersect(Target.EntireRow, Range("7:60")) If r Is Nothing Then Exit Sub Set r = Intersect(r, Range("B:D,F:G,J:K,M:O,Q:R,U:V,X:Y,AB:AC")) For Each c In r Select Case c.Value Case Is < 0, Is > 100 myColor = xlAutomatic Case Is < 30 myColor = 3 '赤色 Case Is <= 100 myColor = 10 '緑色 End Select c.Font.ColorIndex = myColor Next End Sub （マナ） 2016/05/22(日) 16:32 ---- 初めの質問に緑の条件が加わったので、もう一回条件付き書式の設定方法を記載しておきます。 条件の優先順位を変更できるなら、設定順は気にせず後で優先順位を入れ替えて下さい。 入替が分からないのでしたら、以下の設定順序を守って設定して下さい。 1)シート全体を選択 2)条件付き書式→新しいルール→数式を使用して、書式設定するセルを決定。 3)数式入力欄に、=AND(A$6<>"付加点",A$6<>"評定",ROW()>6,A1<=100)　を入力。(コピペでも可) 4)フォントの色を緑に設定。 5)条件付き書式→新しいルール→数式を使用して、書式設定するセルを決定。 6)数式入力欄に、=AND(A$6<>"付加点",A$6<>"評定",ROW()>6,A1<30)　を入力。(コピペでも可) 7)フォントの色を赤に設定。 以上です。 列や行の挿入や削除、別シートからのコピペなども、シート全体で設定していたら、何でもありに対応してくれます。 （sy） 2016/05/22(日) 18:40 ---- 因みにマクロで条件付き書式と同等までの機能を持たせるなら以下のようにちょっと複雑になります。 変更箇所と関数セルのみ対象にすると物凄く複雑になるので、マナさんと同じに行全てを再設定しています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer Dim i As Integer Dim c As Range, Rng As Range Set Rng = Intersect(Target, Rows("7:" & Rows.Count), Range("A1").CurrentRegion) If Rng Is Nothing Then Exit Sub For Each c In Rng.Columns(1).Cells For i = 2 To Cells(6, Columns.Count).End(xlToLeft).Column If InStr("付加点,評定", Cells(6, i).Value) = 0 Then Select Case Cells(c.Row, i).Value Case Is < 30 myColor = 3 '赤色 Case Is <= 100 myColor = 10 '緑色 Case Else myColor = xlAutomatic End Select Cells(c.Row, i).Font.ColorIndex = myColor End If Next i Next c End Sub （sy） 2016/05/22(日) 18:50 ---- 変更箇所のみ色設定バージョン。 操作してみて違いが感じられないようです。 コードが複雑になっただけで、意味ないかもしれません。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer Dim r As Range, r2 As Range Dim c As Range Set r = Intersect(Target, Range("7:60")) If r Is Nothing Then Exit Sub Set r = Intersect(r, Range("B:D,F:G,M:O,Q:R,U:V,X:Y,AB:AC")) On Error Resume Next Set r2 = Intersect(Target.Dependents, Target.EntireRow.Range("J1:K1")) On Error GoTo 0 If Not r2 Is Nothing Then If r Is Nothing Then Set r = r2 Else Set r = Union(r, r2) End If End If If r Is Nothing Then Exit Sub For Each c In r Select Case c.Value Case Is < 0, Is > 100 myColor = xlAutomatic Case Is < 30 myColor = 3 '赤色 Case Is <= 100 myColor = 10 '緑色 End Select c.Font.ColorIndex = myColor Next End Sub （マナ） 2016/05/22(日) 19:54 ---- おはようございます。 列や行が少ないと全体を処理しても変わらないですねぇ。 今回は条件付き書式と比較する為に書きましたが、 私のコードなら条件付き書式をお勧めします。 マクロでするなら、一から作る手間や修正が出た時の手間を考えたら、 分かりやすいマナさんのコードをお勧めします。 （sy） 2016/05/23(月) 08:19