[[20170106102935]] 『セルの数値などによってセルの色を変えたい』(ウルトラ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『セルの数値などによってセルの色を変えたい』(ウルトラ)

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

 Cells(i, "F").Interior.ColorIndex = 3 '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, "F") >= 1 And Cells(i, "F") < 4 Then
 Cells(i, "F").Interior.ColorIndex = 6 '6は黄色
End If
If Cells(i, "F") >= 4 And Cells(i, "F") < 10 Then
 Cells(i, "F").Interior.ColorIndex = 20 '20は淡い青色
End If
If Cells(i, "G") >= 1 And Cells(i, "G") < 10 Then
 Cells(i, "G").Interior.ColorIndex = 6 '6は黄色
End If
If Cells(i, "J") >= "欠" Then
 Cells(i, "J").Interior.ColorIndex = 46 '46は薄いオレンジ
End If

 上記の条件でマクロを実行すると、指定された条件のセルE,黄色F,赤色G,黄色H,白色I白色,J,薄いオレンジ色になってしまい、
 思うような結果が得られないのです。

 これを下記のようにしたい時どのように設定したらよいか、教えて頂けませんか。

 1.E,F,G,H,のセルが0(ゼロの時)赤色にする。
 2.E〜Iのセルが空白(空欄)のセルは薄いオレンジ色にする。

< 使用 Excel:Excel2013、使用 OS:Windows10 >


どのセルを変えたいのかは判りませんが、元コードから判断して…。

    If WorksheetFunction.Sum(Range("E" & i & ":H" & i)) = 0 Then
        Cells(i, "F").Interior.ColorIndex = 3 '3は赤色
    End If
    If WorksheetFunction.CountBlank(Range("E" & i & ":I" & i)) = 5 Then
        Cells(i, "J").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
(???) 2017/01/06(金) 11:26

各列に対して処理をするなら、
列も変数にして処理を繰り返す必要がありますね。
その時にアルファベットじゃなくて番号で列を指定可能です。

Sub test()

    Dim ixRow As Long
    Dim ixCol As Long

    ixRow = 3

    For ixCol = 5 To 9
        If Cells(ixRow, ixCol).Value = 0 Then
            Cells(ixRow, ixCol).Interior.ColorIndex = 3
        ElseIf Cells(ixRow, ixCol).Value = Empty Then     '空白の時
            Cells(ixRow, ixCol).Interior.ColorIndex = 46
        End If
    Next
End Sub

あぁ、でも条件の範囲が微妙にちがうのですね^^;
Sub test()

    Dim ixRow As Long
    Dim ixCol As Long

    ixRow = 3

    For ixCol = 5 To 8
        If Cells(ixRow, ixCol).Value = 0 Then
            Cells(ixRow, ixCol).Interior.ColorIndex = 3
        End If
    Next
    For ixCol = 5 To 9
        If Cells(ixRow, ixCol).Value = Empty Then     '空白の時
            Cells(ixRow, ixCol).Interior.ColorIndex = 46
        End If
    Next
End Sub

また、たくさんの条件ごとに色分けしたいならSlect Caseステートメントのほうが
よいですね。
http://excelvba.pc-users.net/fol6/6_2.html

でも、セルに色を付けるだけなら、
条件付き書式設定で処理した方がいいかも?

(まっつわん) 2017/01/06(金) 11:37


(???)さん・(まっつわん)さん、どうもすみません、勝手をいいます。うまく行きませんでした。昨年のデーターを再度修正していて、条件付き書式設定でやった記憶がありましたが、この際マクロで思ってのことでもあります。初心者ですみません。

1.E,F,G,H,のセルが0(ゼロの時)赤色にする。
2.E〜Iのセルが空白(空欄)のセルは薄いオレンジ色にする。

1.については、自力でなんとか出来ました。
しかし、

2.ついては
J列に「欠」が入っているので、その行のE列〜I列のセルが薄いオレンジ色になればよいのですが、教えて頂けますか。
(ウルトラ) 2017/01/06(金) 15:06


何がどううまくいかなかったのか、具体的に書いてください。少なくとも、皆さん自分で思ったとおりの結果になる事は確認してコードをアップしているはずですから、貴方の考えている結果とは違うだけかと思います。 条件と結果が、正しく伝わるようにお願いします。

> 2.E〜Iのセルが空白(空欄)のセルは薄いオレンジ色にする。
これは、以下のどれを指していますか?

(1)E、F、G、H、Iそれぞれ空欄だったら、それぞれのセルをオレンジ色にする?(これなら、条件付き書式を使う方が簡単)
(2)元のコードから判断すると、全部空欄だったらJのセルをオレンジにする?(私のコードはこれ)
(3)最新の説明から判断すると、J列のセルが"欠"だったら、E〜Iのセルを全てオレンジにする?(元のコードはJ列だけ塗っていたので、これをRangeで範囲指定するだけ)
(???) 2017/01/06(金) 15:42


こうかな?
J列に「欠」の入っている行のE列〜I列の空欄セルに色付け。
J列に「欠」が入っていなければE列〜I列に空欄があっても色付けなし。

Sub test()

    Dim lastrow As Long
    Dim i As Long
    Dim r As Long

    lastrow = Range("E" & Rows.Count).End(xlUp).Row 'E列の最後まで値が入っている場合の最終行

        For i = 1 To lastrow
        For r = 5 To 9
            If Cells(i, r).Value = Empty And Cells(i, "J").Value = "欠" Then
                Cells(i, r).Interior.ColorIndex = 46
            End If
        Next
        Next
End Sub

違ったらごめんなさい。
(pooh) 2017/01/06(金) 16:08


>2.ついては
>J列に「欠」が入っているので、その行のE列〜I列のセルが薄いオレンジ色になればよい
オートフィルターを使って抽出したセルに色を付ければいいですが、
シート上の表がどうなってるかこちらではわかりませんので、
サンプルを考えるのはやめておきます。

http://officetanaka.net/excel/vba/tips/tips155d.htm
http://www.excel.studio-kazu.jp/kw/20110418003634.html
この辺が参考になると思います。
(まっつわん) 2017/01/06(金) 16:13


すみません、条件と結果が、正しく伝わるように説明できなくて、申し訳ありません。

(3)最新の説明から判断すると、J列のセルが"欠"だったら、E〜Iのセルを全てオレンジにする?(元のコードはJ列だけ塗っていたので、これをRangeで範囲指定するだけ)

このことです。その時に以下のように範囲を指定したらできました。

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

        Cells(Range("E").Interior.ColorIndex = 46 '46は薄いオレンジ
    End If
("E")この部分を変えることでできました。範囲指定のことがわかっていませんでした。迷惑をかけました。ありがとうございました。
 また、色々な方々にお教え頂き感謝しています。

(ウルトラ) 2017/01/07(土) 09:32


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.