[[20160520224114]]　『Excel　マクロ　特定の数字を赤にする』（ウルトラ）　ページの最後に飛ぶ

『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

コメント返信：

[ 一覧(最新更新順) ]

[[20160520224114]] 『Excel マクロ 特定の数字を赤にする』（ウルトラ） ページの最後に飛ぶ

[[20160520224114]]　『Excel　マクロ　特定の数字を赤にする』（ウルトラ）　ページの最後に飛ぶ