Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1320 / 13645 ツリー ←次へ | 前へ→

【75084】マクロで、セルに色をつけたいです。 しずか 13/12/10(火) 2:14 質問[未読]
【75090】Re:マクロで、セルに色をつけたいです。 [名前なし] 13/12/10(火) 16:31 回答[未読]
【75096】Re:マクロで、セルに色をつけたいです。 しずか 13/12/10(火) 20:52 お礼[未読]
【75100】Re:マクロで、セルに色をつけたいです。 しずか 13/12/11(水) 11:55 お礼[未読]
【75102】Re:マクロで、セルに色をつけたいです。 [名前なし] 13/12/11(水) 18:19 回答[未読]
【75112】Re:マクロで、セルに色をつけたいです。 しずか 13/12/12(木) 17:29 お礼[未読]

【75084】マクロで、セルに色をつけたいです。
質問  しずか  - 13/12/10(火) 2:14 -

引用なし
パスワード
   はじめまして。よろしくお願いいたします。

<困っていること>

膨大な数値データがあります。
その値によって、セルを色分けをしたいのです。

が、条件付書式はエクセル2003である為、三つまでしか使えません。

シートコードを利用してみたのですが、
新しく、セルに入力をしないと色がつきません。
また、複数のセルを同時にコピペした場合、エラーが起こります。


なので、通常のマクロを組んだほうがいいのではないかと思いました。
が、当方、オートマクロを少しいじるか、
グーグルで調べてコピペしたものを少々修正する程度の知識しか持ち合わせておらず困っています。
どなたか教えていただけないでしょうか?
よろしくお願いいたします。

以下、やりたいことの詳細です。

--------------------------


セルB10から10×10の数値データがあります。
これをAグループとします。

同シート内に
数値の違う同様のデータがDグループまであって、

B25
B40
B55
と、続きます。

Aグループには、1〜100の数字がランダムに
Bグループには、10〜150の数字がランダムに
Cグループには、50〜200の数字がランダムに
Dグループには、80〜300の数字がランダムに
入ってます。

それぞれのグループのセルを10段階で色分けしたいです。

Aグループなら、
1以上10未満
10以上20未満
と、続いて
90以上100
それ以外と、空白は塗り潰しなし。

Bグループなら、
10以上〜20未満
20以上〜35未満
と、続いて
130以上〜150
それ以外と、空白は塗り潰しなし。


といった感じです。

【75090】Re:マクロで、セルに色をつけたいです。
回答  [名前なし]  - 13/12/10(火) 16:31 -

引用なし
パスワード
   A以外のグループの条件がよくわかりませんので・・
それぞれの範囲ごとに色を付けるしかないのでは??
それぞれのグループに範囲名をつけるとして
(範囲名を付けない場合はRange("b10:k19") やRange(Range("b10"), Range("b10").Offset(10, 10))としてください)
Sub macro2()
  Dim rng As Range
  Dim rcolor()
  rcolor = Array(RGB(1, 128, 255), RGB(0, 255, 255), RGB(204, 255, 204), RGB(75, 255, 75), _
           RGB(255, 255, 153), RGB(255, 255, 0), RGB(255, 204, 0), _
          RGB(255, 153, 0), RGB(255, 102, 0), RGB(255, 0, 0))
  For Each rng In Range("Aグループ")
  'For Each rng In Range(Range("b10"), Range("b10").Offset(10, 10))
    Select Case rng.Value
    Case 1 To 99
      rng.Interior.Color = rcolor(Int(rng.Value / 10))
    Case 100
      rng.Interior.Color = rcolor(9)
    Case Else
      rng.Interior.Color = RGB(255, 255, 255)
    End Select
  Next
  For Each rng In Range("Bグループ")
    Select Case rng.Value
    Case 10 To 19
      rng.Interior.Color = rcolor(1)
    Case 20 To 34
      rng.Interior.Color = rcolor(2)
    '・
    '・
    Case 130 To 150
      rng.Interior.Color = rcolor(9)
    Case Else
      rng.Interior.Color = RGB(255, 255, 255)
    End Select
  Next
End Sub
カラーは適当につけましたがセルに見本をおいて
  rcolor = Array(Range("A1").Interior.Color,Range("A2").Interior.Color ・・・)
とした方がいいかも。

【75096】Re:マクロで、セルに色をつけたいです。
お礼  しずか  - 13/12/10(火) 20:52 -

引用なし
パスワード
   ありがとうございます。
今日これから早速試してみたいと思います。

明日までには、結果を返信させていただきます。
本当にありがとうございました。

【75100】Re:マクロで、セルに色をつけたいです。
お礼  しずか  - 13/12/11(水) 11:55 -

引用なし
パスワード
   本当にありがとうございます。
うまくできました!!

申し訳ありませんが、もうひとつ質問させてください。

範囲に名前をつけてこのマクロを動かしています。
別シートにも、同じ作業をする場所がありまして

色付範囲01
色付範囲02
 ・
 ・
 ・
といった具合になっております。
下記のように指定しているのですが、

  For Each rng In Range("色付範囲01")

シートを移るたびに、名前を指定しなおさなくてはなりません。

何かいい方法がありましたら、ご教授願えますでしょうか。
よろしくお願いいたします。

【75102】Re:マクロで、セルに色をつけたいです。
回答  [名前なし]  - 13/12/11(水) 18:19 -

引用なし
パスワード
   シートで色付け範囲の位置が違うなら修正が必要ですが・・

位置が同じで同条件なら
For Each rng In Range("色付範囲01")

For Each rng In Range("b10").Resize(10, 10)
For Each rng In Range(Range("b10"), Range("b10").Offset(10, 10))
For Each rng In Range("b10:k19")
などと直接に指定するといいです。

あと↑コードだとかなり長くなるのでしきい値を配列で持つと

Sub 色付け1()
  Dim rlimen 'しきい値(最小値,(9個のしきい値),最大値)
  rlimen = Array(1, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
  Call 色付け2(rlimen, Range("b10")) 'b10から10*10範囲
  
  rlimen = Array(10, 21, 35, 50, 65, 70, 85, 100, 115, 130, 150)
  Call 色付け2(rlimen, Range("b25"))
  
  rlimen = Array(50, 61, 75, 90, 105, 120, 135, 150, 165, 180, 200)
  Call 色付け2(rlimen, Range("b40"))
  
  rlimen = Array(80, 100, 123, 145, 167, 199, 221, 243, 265, 287, 300)
  Call 色付け2(rlimen, Range("b55"))
End Sub

Private Sub 色付け2(rlimen, clrange As Range)
  Dim rng As Range
  Dim rcolor()
  rcolor = Array(RGB(211, 255, 255), RGB(178, 255, 255), RGB(204, 255, 204), RGB(75, 255, 75), _
           RGB(255, 255, 153), RGB(255, 255, 0), RGB(255, 204, 0), _
          RGB(255, 153, 0), RGB(255, 102, 0), RGB(255, 0, 0))
  For Each rng In clrange.Resize(10, 10)
    Select Case rng.Value
    Case rlimen(0) To rlimen(1) - 1
      rng.Interior.Color = rcolor(0)
    Case rlimen(1) To rlimen(2) - 1
      rng.Interior.Color = rcolor(1)
    Case rlimen(2) To rlimen(3) - 1
      rng.Interior.Color = rcolor(2)
    Case rlimen(3) To rlimen(4) - 1
      rng.Interior.Color = rcolor(3)
    Case rlimen(4) To rlimen(5) - 1
      rng.Interior.Color = rcolor(4)
    Case rlimen(5) To rlimen(6) - 1
      rng.Interior.Color = rcolor(5)
    Case rlimen(6) To rlimen(7) - 1
      rng.Interior.Color = rcolor(6)
    Case rlimen(7) To rlimen(8) - 1
      rng.Interior.Color = rcolor(7)
    Case rlimen(8) To rlimen(9) - 1
      rng.Interior.Color = rcolor(8)
    Case rlimen(9) To rlimen(10)
      rng.Interior.Color = rcolor(9)
    Case Else
      rng.Interior.Color = RGB(255, 255, 255)
    End Select
  Next
End Sub

こんな感じでだいぶスッキリします。
しきい値が(最大値-最小値)/10ならさらに短くなりますが・・・

【75112】Re:マクロで、セルに色をつけたいです。
お礼  しずか  - 13/12/12(木) 17:29 -

引用なし
パスワード
   出来ました!!

本当にありがとうございました。

おかげで仕事が早く進みます。

また、何かありました時は
どうぞ、よろしくお願いいたします。

1320 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free