エクセルVBA 条件にあうときセルを塗りつぶすには?
エクセルVBAについて教えてください。
_________A 列 _________B 列_________C列_________D列
--------------------------------------------
1行| 基準値_________ 5_____________1____________8
2行| りんご____________1_____________9____________0
3行| みかん___________12___________5____________3
4行| ぶどう____________15___________7____________8
5行| バナナ____________3_____________1____________4
上図のようにデータがあります。
(実物は列行共に膨大です。また条件を4つ以上つける予定なので条件付書式は使えません)
各列の基準値に対して、セルの増減が、0以下のときに黄色に、5から8のとき大きくなるときに赤、9以上のときに青にセルの色を塗りつぶしたいです。
どのようにすればよいでしょうか?
B列の場合、基準値が5です。
B2のセルの場合、基準値5と1(B2セル)の増減は-4です。
増減が0以下のときは黄色に、増減が5から8のときは赤に、増減が9以上のときに青にするので、このときは黄色に塗りつぶします。
B3のセルの場合、基準値5と12(B3セル)の増減は7です。
増減が5から8のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。
B4のセルの場合、基準値5と15(B4セル)の増減は10です。
増減が9以上のとき青色に塗りつぶすので、このセルは青色に塗りつぶします。
C2のセルの場合は、C列の基準値は1(C1セル)です。
基準値1と9(C2のセル)の増減は8です。
増減が5から8のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。
よろしくお願いいたします。
No.12ベストアンサー
- 回答日時:
すみません つまらないミスに気づきました
誤)For Each C In Range(Cells(2,1), Cells( Endclo , Endrow))
正)For Each C In Range(Cells(2,1), Cells( Endrow , Endcol))
これよく間違えてしまいます
Cells表記は左が行、右が列です
今日は外出していたので、お礼が遅くなって申し訳ございません。
昨日から大変お世話になり、本当にありがとうございました。
教えて頂いたコードで無事実行することができました。
今回VBAを教えて頂き、VBAを勉強してみようと思いました。
そして、早速VBAの本を買いました。
VBAの本を片手に自分なりにコードを一部変えてみました。
Private Sub SetColor1()
Dim i As Long
Dim Col As Integer
Dim atai As Integer
Dim area As String
Dim keyCells As String
Dim Endrow As Long
'基準値の行を指定
Col = 2
'基準値の下のセルを指定
area = "b3"
Endrow = Range(area).End(xlDown).Row
'塗りつぶし対象となる起点「d3」と塗りつぶし対象末の列「i」を指定
For Each c In Range("d3:i" & Endrow)
atai = c.Value - Cells(Col, c.Column)
If c.Value <> "" Then
Select Case atai
Case Is <= -1
c.Interior.ColorIndex = 6
Case 5 To 8
c.Interior.ColorIndex = 3
Case Is >= 9
c.Interior.ColorIndex = 5
End Select
End If
Next
End Sub
No.13
- 回答日時:
単に、範囲の取り方の問題が解決出来れば、それでできると思いますが……
以下の場合、A1が最初でないと、ちょっとややこしいことになりそうな気がします。
'//標準モジュールが良い
Sub Test1()
Dim r As Range
Dim i As Long, j As Long
Dim ret As Double
Set r = Range("A1").CurrentRegion
Set r = r.Offset(, 1).Resize(, r.Columns.Count - 1)
r.Interior.ColorIndex = xlColorIndexNone
Application.ScreenUpdating = False
With r
For j = 1 To r.Columns.Count
For i = 2 To r.Rows.Count - 1
ret = .Cells(i, j).Value - .Cells(1, j).Value
If ret <= 0 Then
.Cells(i, j).Interior.ColorIndex = 6
ElseIf ret > 4 And ret < 9 Then
.Cells(i, j).Interior.ColorIndex = 3
ElseIf ret > 8 Then
.Cells(i, j).Interior.ColorIndex = 5
End If
Next i
Next j
End With
Application.ScreenUpdating = True
End Sub
No.11
- 回答日時:
更に、
エクセルの質問はこの掲示板では無理がありますね
インデントも反映されないし・・
http://www.officetanaka.net/
ここを使うのをお勧めします
この中に掲示板というのがあります
このサイトの利点は 質問したいエクセルブックを掲示板にアップロードできることです
説明が難解、 回答がなかなか理解できない
そのばあいに実際のブックをアップロードできるので
回答者も質問者の意図を理解しやすいのです
但し、アップロードするブックのプロパティを見て
個人情報(ユーザー名、会社名)は削除してからアップロードすること)
ワタシもここにお世話になっています
No.10
- 回答日時:
♯8の For Each C In Range(”B2:" & Endclo & Endrow)
は間違いです ♯9のコードでやってください
ワタシは今 京橋のベろーチェでアイスコーヒーを飲みながら約束の時間まで
時間つぶしをしていますが何か?
No.9
- 回答日時:
基点セルは
For Each C In Range(Cells(2,1), Cells( Endclo , Endrow))
のcells(2,1)です これは2列目の1行目 をあらわしています
Dim i As Long
Dim atai As Integer
Dim Endrow As Long
Dim EndCol As Integer
Endclo=Range("a1").End(xlToRight)
Endrow = Range("a2").End(xlDown).Row
For Each C In Range(Cells(2,1), Cells( Endclo , Endrow))
atai = c.Value - Cells(1, c.Column)
If c.Value <> "" Then
Select Case atai
Case Is <= 0
c.Interior.ColorIndex = 6
Case 5 To 8
c.Interior.ColorIndex = 3
Case Is >= 9
c.Interior.ColorIndex = 5
End Select
End If
Next
End Sub
No.8
- 回答日時:
>また、行や列が追加されたときに、起点?(表の始まり)が変わるのです
行は最終行を自動で取得していますので何もしなくていいです
列は手動ですので
For Each C In Range(”B2:D" &Endrow)
このDを変更します
自動で取得する場合は
Dim EndCol As Integer
Endclo=Range("a1").End(xlToRight)
For Each C In Range(”B2:" & Endclo & Endrow)
にします
Endclo=Range("a1").End(xlToRight)は
Endrow = Range("a2").End(xlDown).Rowのすぐ下に書いてください
以上です これによって行も列の自動的に増えた分に対応します
なお基点は自動にはできません
B2のところを変えてください
No.7
- 回答日時:
追伸:
今回使ったコードは下記で構成されています
繰り返し処理 For Each~
これは指定範囲(今回はB2:D取得した最終行)の範囲のセルを
1こずつ処理する方法です ”C”がそれにあたり今ここを見ています
という情報がCに格納されます
Cが空白でなかったばあい~
そのときのCの値、Cの列情報(Column)を取得して比較基本セルを指定します
比較基本セルの行は固定ですがCは位置が変動するのでそのときの列を指定する
必要があります
で、これを引き算した結果をAtaiに格納します
Select Case~
これは条件分岐処理です
ataiに格納された数値によって処理を分岐します
色塗りは説明しなくてもいいですよね
マクロの自動記録でも記録されますからそれから余分なものを排除すればいいのです
For Each~は動作速度は比較的遅いですが理解しやすいでしょう
ワタシはこれをよく利用します
初心者域では動作スピードよりもコードを理解しやすいものを選んで使ったほうがいいです
No.6
- 回答日時:
>VBAを全く触ったことがない超初心者なので、ヒントを頂いても全く応用がききません。
ならばこれはきちんと書いたほうがよい!
あんまり時間が無いときに さらっと書いたので細かいところはわかるだろうと
判断しました まったくの初心者とは想像外でした
初心者ならばVBAなんて言葉すら知らないだろうし・・。
以上です
回答者は質問者の事情がわかりません
具体的に簡潔にそういう事情も書いたほうが早く目的にたどり着けます
質問の例(なにをしたいのか)は非常にわかりやすかったのは評価いたします。
この回答への補足
最初から最後まで頼りっぱなしで、本当に申し訳ないです。
サンプル例はD列までですが、AA列まであるときは、どこを変えればよいのでしょうか?
また、行や列が追加されたときに、起点?(表の始まり)が変わるのですが、そのときは、どこを変えればよいのでしょうか?
まことに申し訳ないのですが、ご回答いただければありがたいです。
No.5
- 回答日時:
これならよいですか?
Sub 色塗り()
Dim c As Range
Dim i As Long
Dim atai As Integer
Dim Endrow As Long
Endrow = Range("a2").End(xlDown).Row
For Each c In Range("b2:d" & Endrow)
atai = c.Value - Cells(1, c.Column)
If c.Value <> "" Then
Select Case atai
Case Is <= 0
c.Interior.ColorIndex = 6
Case 5 To 8
c.Interior.ColorIndex = 3
Case Is >= 9
c.Interior.ColorIndex = 5
End Select
End If
Next
End Sub
No.4
- 回答日時:
え”?
丸投げですか・?
空白も色が付くならば
If c.Offset(0, 1).Value <> "" Then
を追加してやればいいし
1行しか処理できないとあるけど
補足にも書いたように 同じようにフィールド番号を書きかえてコードを追加してやれば
いいんじゃないですか そう書いたつもりだけど・・
少しは考えようよ。
この回答への補足
丸投げ・・・。そうですよね。本当に申し訳ないです。
VBAを全く触ったことがない超初心者なので、ヒントを頂いても全く応用がききません。
通常はエクセルの条件付書式で行うのですが、条件が4つ以上あるために、その機能も使えません。
教えていただいた下のコードで、B列は処理をできました。
For Each c In Range("a2:a" & Endrow)
atai = c.Offset(0, 1).Value - Range("b1").Value
If atai <= 0 Then
c.Offset(0, 1).Interior.ColorIndex = 6
End If
Next
このコードを参考にして、C列も考えてはいるものの、根本的なことがわかっていないため自分の力で実現できそうにありません。
もう少し、助けていただけないでしょうか?
よろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
i=cells(Rows.Count, 1)とi=cel...
-
ExcelVBAを使って、値...
-
特定のセルが空白だったら、そ...
-
【Excel VBA】指定行以降をクリ...
-
【Excel】指定したセルの名前で...
-
ExcelのVBAで数字と文字列をマ...
-
【VBA】指定したセルと同じ値で...
-
Excelで指定した日付から過去の...
-
セルの値だけクリップボードに...
-
DatagridViewの値確定
-
TODAY()で設定したセルの日付...
-
VBAコマンドボタンを押すたびに...
-
Excelのプルダウンで2列分の情...
-
DataGridViewの各セル幅を自由...
-
エクセルvba:自己セルの情報取...
-
DataGridViewのセル編集完了後...
-
セル色なしの行一括削除
-
【VBA】シート上の複数のチェッ...
-
スプレッドシートをGASでセル保...
-
EXCELのVBA-フィルタ抽出後の...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
i=cells(Rows.Count, 1)とi=cel...
-
ExcelVBAを使って、値...
-
【Excel VBA】指定行以降をクリ...
-
特定のセルが空白だったら、そ...
-
EXCELで変数をペーストしたい
-
Excelで指定した日付から過去の...
-
VBAの間違い教えて下さい
-
【Excel】指定したセルの名前で...
-
Excelのプルダウンで2列分の情...
-
エクセルVBAでコピーして順...
-
Excel vbaで特定の文字以外が入...
-
Excel VBA、 別ブックの最終行...
-
【VBA】指定したセルと同じ値で...
-
特定の文字を条件に行挿入とそ...
-
TODAY()で設定したセルの日付...
-
screenupdatingが機能しなくて...
-
VBA初心者です。次のVBAコード...
-
指定した条件で行セルを非表示...
-
VBAでセルをクリックする回...
-
DataGridViewの各セル幅を自由...
おすすめ情報