こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルVBA 条件にあうときセルを塗りつぶすには?

エクセル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のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。


よろしくお願いいたします。

投稿日時 - 2010-09-28 23:26:48

QNo.6214926

すぐに回答ほしいです

質問者が選んだベストアンサー

すみません つまらないミスに気づきました

誤)For Each C In Range(Cells(2,1), Cells( Endclo , Endrow))

正)For Each C In Range(Cells(2,1), Cells( Endrow , Endcol))

これよく間違えてしまいます

Cells表記は左が行、右が列です

投稿日時 - 2010-09-29 10:35:19

お礼

今日は外出していたので、お礼が遅くなって申し訳ございません。
昨日から大変お世話になり、本当にありがとうございました。
教えて頂いたコードで無事実行することができました。
今回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

投稿日時 - 2010-09-29 23:12:46

ANo.12

このQ&Aは役に立ちましたか?

4人が「このQ&Aが役に立った」と投票しています

回答(13)

ANo.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

投稿日時 - 2010-09-29 16:00:53

ANo.11

更に、

エクセルの質問はこの掲示板では無理がありますね
インデントも反映されないし・・

http://www.officetanaka.net/

ここを使うのをお勧めします
この中に掲示板というのがあります
このサイトの利点は 質問したいエクセルブックを掲示板にアップロードできることです
説明が難解、 回答がなかなか理解できない
そのばあいに実際のブックをアップロードできるので
回答者も質問者の意図を理解しやすいのです

但し、アップロードするブックのプロパティを見て
個人情報(ユーザー名、会社名)は削除してからアップロードすること)

ワタシもここにお世話になっています

投稿日時 - 2010-09-29 09:56:42

ANo.10

♯8の For Each C In Range(”B2:" & Endclo & Endrow)

は間違いです ♯9のコードでやってください


ワタシは今 京橋のベろーチェでアイスコーヒーを飲みながら約束の時間まで
時間つぶしをしていますが何か?

投稿日時 - 2010-09-29 09:52:16

ANo.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

投稿日時 - 2010-09-29 09:50:19

ANo.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のところを変えてください

投稿日時 - 2010-09-29 09:44:28

ANo.7

追伸:

今回使ったコードは下記で構成されています

繰り返し処理 For Each~
 これは指定範囲(今回はB2:D取得した最終行)の範囲のセルを
 1こずつ処理する方法です ”C”がそれにあたり今ここを見ています
 という情報がCに格納されます 
 
 Cが空白でなかったばあい~
 そのときのCの値、Cの列情報(Column)を取得して比較基本セルを指定します
 比較基本セルの行は固定ですがCは位置が変動するのでそのときの列を指定する
 必要があります 
 で、これを引き算した結果をAtaiに格納します

Select Case~

 これは条件分岐処理です 
 ataiに格納された数値によって処理を分岐します


色塗りは説明しなくてもいいですよね
マクロの自動記録でも記録されますからそれから余分なものを排除すればいいのです


For Each~は動作速度は比較的遅いですが理解しやすいでしょう
ワタシはこれをよく利用します
初心者域では動作スピードよりもコードを理解しやすいものを選んで使ったほうがいいです



 

投稿日時 - 2010-09-29 09:36:56

ANo.6

>VBAを全く触ったことがない超初心者なので、ヒントを頂いても全く応用がききません。


ならばこれはきちんと書いたほうがよい!


あんまり時間が無いときに さらっと書いたので細かいところはわかるだろうと
判断しました まったくの初心者とは想像外でした
初心者ならばVBAなんて言葉すら知らないだろうし・・。


以上です

回答者は質問者の事情がわかりません
具体的に簡潔にそういう事情も書いたほうが早く目的にたどり着けます

質問の例(なにをしたいのか)は非常にわかりやすかったのは評価いたします。

投稿日時 - 2010-09-29 09:26:38

補足

最初から最後まで頼りっぱなしで、本当に申し訳ないです。
サンプル例はD列までですが、AA列まであるときは、どこを変えればよいのでしょうか?

また、行や列が追加されたときに、起点?(表の始まり)が変わるのですが、そのときは、どこを変えればよいのでしょうか?

まことに申し訳ないのですが、ご回答いただければありがたいです。

投稿日時 - 2010-09-29 09:33:39

ANo.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

投稿日時 - 2010-09-29 08:14:42

補足

ありがとうございます。
教えていただいた方法で、できそうです。
会社で試してみます。
本当に感謝します。

投稿日時 - 2010-09-29 09:11:25

ANo.4

え”?

丸投げですか・?

空白も色が付くならば

If c.Offset(0, 1).Value <> "" Then
を追加してやればいいし
1行しか処理できないとあるけど
補足にも書いたように 同じようにフィールド番号を書きかえてコードを追加してやれば
いいんじゃないですか そう書いたつもりだけど・・

少しは考えようよ。

投稿日時 - 2010-09-29 06:06:44

補足

丸投げ・・・。そうですよね。本当に申し訳ないです。
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列も考えてはいるものの、根本的なことがわかっていないため自分の力で実現できそうにありません。
もう少し、助けていただけないでしょうか?
よろしくお願いいたします。

投稿日時 - 2010-09-29 09:02:26

ANo.3

補足:

c.Offset(0, 1).Interior.ColorIndex = 6

A列を基準にしてレコードがなくなるまで処理をします

A列基準からいくつずれているかを指定するのがOffsetであり
Offset(0,1)とは A列の同じ行数の1個右のセルという意味です

投稿日時 - 2010-09-29 00:38:34

ANo.2

こんな感じ?

これを基本に同じようにC、D列もやってみればよろしい

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("a2:a" & Endrow)

atai = c.Offset(0, 1).Value - Range("b1").Value

Select Case atai
Case Is <= 0
c.Offset(0, 1).Interior.ColorIndex = 6

Case 5 To 8
c.Offset(0, 1).Interior.ColorIndex = 3

Case Is >= 9
c.Offset(0, 1).Interior.ColorIndex = 5


End Select

Next

End Sub

投稿日時 - 2010-09-29 00:35:09

補足

この方法だと、エクセルの最終行65???まで黄色に塗りつぶされてしまいます。
また、1列毎しか処理ができないのでしょうか?
指定エリアを1つの関数で処理することはできないのでしょうか?

投稿日時 - 2010-09-29 01:23:25

ANo.1

 エクセルのヘルプから、条件付き書式を検索してください。
 やり方も簡単ですがちゃんと説明してあります。
 

投稿日時 - 2010-09-29 00:11:49

補足

質問にも記入しておりますが、条件を4つ以上つけるので、条件付き書式がつかえません。

投稿日時 - 2010-09-29 00:32:11

あなたにオススメの質問