• 締切済み

EXCELで4色の色をつけるVBA(既存)を最後のシートまで実行するには?

エクセルのVBAで質問です。 現在、下記のVBAにて、エクセルに4色の色をつけています。 内容 ・処理範囲内(D5:AI50)の列の値が、 ・指定した行(4行目)の値から見て、 ・+5、+10、-5、-10の場合、それぞれ指定した色をつけています ・ただしC列の値が30未満の行は色付けなし 現状では、このマクロはアクティブシートのみで使えるため、 100シートあれば、それぞれのシートにおいて そのつどマクロを実行しています。 これを、一度の実行で最終シートまで実行できるようにしたいのです。 VBA初心者のため、見よう見まねでループを試してみたものの、 どうもうまく動きませんでした。 なにとぞご教授のほど、お願いいます。 ●以下、現在使用しているVBA Sub 条件付4色の標本数1() Dim 処理範囲 As Range Dim 先頭の行番号 As Long Dim 全体の行数 As Long Dim 各セル As Range Dim 差分 As Single Dim 標本数 As Single Set 処理範囲 = Range("D5:AI50") For Each 各セル In 処理範囲 標本数 = Cells(各セル.Row, "C").Value If 標本数 >= 30 Then 差分 = 各セル.Value - Cells(4, 各セル.Column).Value    Select Case 差分 Case Is <= -10 各セル.Interior.ColorIndex = 37 'ペールブルー 各セル.Font.ColorIndex = 1 Case Is <= -5 各セル.Interior.ColorIndex = 34 '薄い水色 各セル.Font.ColorIndex = 1 Case Is >= 10 各セル.Interior.ColorIndex = 6 '黄37 各セル.Font.ColorIndex = 1 Case Is >= 5 各セル.Interior.ColorIndex = 19 '薄い黄 各セル.Font.ColorIndex = 1 Case Else 各セル.Interior.ColorIndex = xlNone '無色 End Select End If Next End Sub

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

For eachを使う方法のほかに、全てのシートを1つずつ捉えるには Sub test01() MsgBox Sheets.Count For i = 1 To Sheets.Count MsgBox Sheets(i).Name Next i End Sub を実行してみて、こういう方法もあるということを知ってください。

  • higekuman
  • ベストアンサー率19% (195/979)
回答No.1

For Each の使い方を解っているようなので、シートもFor Eachで回せば良いだけです。 検証していないので、動かない可能性大です(笑) Sub 条件付4色の標本数1() Dim 処理範囲 As Range Dim 先頭の行番号 As Long Dim 全体の行数 As Long Dim 各シート As Worksheet Dim 各セル As Range Dim 差分 As Single Dim 標本数 As Single For Each 各シート In Worksheets With 各シート Set 処理範囲 = .Range("D5:AI50") For Each 各セル In 処理範囲 標本数 = .Cells(各セル.Row, "C").Value If 標本数 >= 30 Then 差分 = 各セル.Value - .Cells(4, 各セル.Column).Value Select Case 差分 Case Is <= -10 各セル.Interior.ColorIndex = 37 'ペールブルー 各セル.Font.ColorIndex = 1 Case Is <= -5 各セル.Interior.ColorIndex = 34 '薄い水色 各セル.Font.ColorIndex = 1 Case Is >= 10 各セル.Interior.ColorIndex = 6 '黄37 各セル.Font.ColorIndex = 1 Case Is >= 5 各セル.Interior.ColorIndex = 19 '薄い黄 各セル.Font.ColorIndex = 1 Case Else 各セル.Interior.ColorIndex = xlNone '無色 End Select End If Next 各セル End With Next 各シート End Sub

tommm77
質問者

お礼

ありがとうございます。 非常にスムーズに動きました! このVBA自体、自分で作ったわけでなないのですが、 勉強したいと思いました。

関連するQ&A

  • エクセル VBA セルの色をSheet1とSheet2の両方を変えたいのですが・・・

    最近困っているところが表題の通りなのですが Sheet1のB2を右クリックするとB2のセルの色を変えて Sheet2のB2のセルも色を変えたいというものです。 現状で Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim Rng As Range, myRng As Range Dim RngA As Range, myRngA As Range Set Rng = Range("B3:W3,b7:w8,b12:w12,d13:w13,d17:w18,d22:w23") Set myRng = Intersect(Target, Rng) If myRng.Interior.ColorIndex = xlColorIndexNone Then myRng.Interior.ColorIndex = 37 Else If myRng.Interior.ColorIndex = 37 Then myRng.Interior.ColorIndex = 45 Else myRng.Interior.ColorIndex = xlColorIndexNone End If End If Cancel = True End Sub とここまではあるのですが、これをどう改造すればSheet2の同じセルの色もかわるのでしょうか? 宜しくお願いいたします

  • エクセルVBAについて

    エクセルVBAについて 下記のようなマクロで、選択したセルの、列の背景色の切り替えを行いたいと思っています。 が、写真のように、塗りつぶしを行いたいセルが結合しているところと、 そうでないところがあり、列全体に、うまく塗りつぶしができません。 '列の背景色を変更 Cells.Interior.ColorIndex = xlNone Dim i As Long i = Target.Column Columns(i).Interior.ColorIndex = 6   Columns(i + 1).Interior.ColorIndex = 6 また、選択するセルは、2行目で、2列が結合しています。 うまく、2列が結合しているセルにも、塗りつぶしを適用することは可能でしょうか? また、できれば列全体の塗りつぶしでなく、行の範囲も指定できればと思っています。 写真では、2列が結合していない部分のみ、塗りつぶしが適用されています。 表の構成上、結合しているセルとそうでないセルの変更ができないため、困っています。 どうぞ、よろしくお願いいたします。

  • Excel VBA・スピンボダンの使用

    VBA勉強中の者です。Excel2002を使用しております。 以前こちらのサイトで「特定セルに入力された数値を基に、別のセルの色を変える方法」を ご教示頂きまして(http://okwave.jp/qa/q6345375.html)、今度はそれを発展させたいと思い フォーム、スピンボタンの使用を試みました。 試行錯誤しましたが残念ながら動作させる事が出来ませんでした。 目的の動作 フォームのスピンボタンを設置、リンクを”=A1”に指定し、ボタン操作でセルA1の数値をボタン入力。 その数値に合わせてセルB1:B6のカラーを変化させたい。 作成したコード Private Sub Worksheet_Change(ByVal Target As Range) Dim mycolor As Range Dim boxcolor As Range Set mycolor = Intersect(Target, Range("A1")) Set boxcolor = Range("B1:B6") If Not mycolor Is Nothing Then Select Case Target.Value Case Is = 1 boxcolor.Interior.ColorIndex = 3 Case Is = 2 boxcolor.Interior.ColorIndex = 4 Case Is = 3 boxcolor.Interior.ColorIndex = 5 Case Is = 4 boxcolor.Interior.ColorIndex = 6 Case Is = 5 boxcolor.Interior.ColorIndex = 7 Case Is = 6 boxcolor.Interior.ColorIndex = 8 Case Is = 7 boxcolor.Interior.ColorIndex = 9 Case Is = 8 boxcolor.Interior.ColorIndex = 10 Case Is = 9 boxcolor.Interior.ColorIndex = 11 Case Is = 10 boxcolor.Interior.ColorIndex = 12 Case Is = 11 boxcolor.Interior.ColorIndex = 13 Case Is = 12 boxcolor.Interior.ColorIndex = 14 Case Else boxcolor.Interior.ColorIndex = xlAutomatic End Select End If End Sub スピンボタンの入力に合わせてセルA1の数値が増減する事は確認しましたが、 それに伴いB1:B6のセルカラーが変化しません。 また、スピンボタンを使用して数値を入力したあと、セルA1を一度アクティブ(F2を押す)にして 解除すると、唐突にしかし正常に動作します。 スピンボタンを使わずにセルA1に直接数値を入力すると、これも問題なく動作します。 以上の状況からスピンボタンを使用しセルA1に入力された数値のみが認識しないように思えます。 色々と調べて見たところ、SpinButton Changeイベントというものを使用する?と見当をつけ、 単純な発想ですがSpinButton1_Changeプロシージャへ上記のコードを入力してもやはり動作しません。 私のレベルでは既に手詰まりになってしまい、お手数ですがご指導頂きたくお願い致します。

  • vba 指定した日付範囲でセルの色を塗る

    急遽、エクセルVBAを組んでくれと頼まれたのでわかる方、教えていただけますか? 開始日時(A行)と終了日時(B行)があり、 開始と終了の範囲でC以降日付になっており 指定の範囲内でセルの色が塗られるいうものなのですが なにせ急ぎとVBAがほとんどわからないのでなるべくわかりやすく 教えていただけるとありがたいです。 ちなみにsheetにコードを記入するのとmoduleにコードを記入するのでは どう違うのですか?わからないまでも一応、色が塗られるところまでは できたのですがどうやってセルの時間を取得して範囲を指定すれば 良いのかなどがわかりませんどうかよろしくお願い致します。 下記は作成途中ですが・・・ Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim row As Integer Dim line As Integer row = 5 line = 9   Set objR = Range("A1").Resize(1, 4).Offset(1, 2) objR.Interior.ColorIndex = 8 End Sub

  • エクセルで特定の文字列の含まれるセルのある行の色を変更したいと思ってお

    エクセルで特定の文字列の含まれるセルのある行の色を変更したいと思っておりますが、関数では出来ないようなのでVBAで作業をしております。なかなかうまくいかずで困ってしまっております。 下記のような関数でシート一枚は出来たのですが、それ以外のシートには反映がされません。 Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range If Application.Intersect(Target, Range("A2:A10000")) Is Nothing Then Exit Sub For Each r In Target If r.Column = 1 Then Select Case r.Value Case "○": r.Resize(1, 12).Interior.ColorIndex = 19 Case "×": r.Resize(1, 12).Interior.ColorIndex = 3 Case "△": r.Resize(1, 12).Interior.ColorIndex = 6 Case Else: r.Resize(1, 12).Interior.ColorIndex = xlNone End Select End If Next r End Sub 無知なので、ネットで調べて上記のような数式を拾ってきたのですが、どうやら1シート分の設定に書かれているようです。。。 全シートに反映がされるように設定をするにはどこをどのように書き換えればよろしいでしょうか。 お分かりの方がいらっしゃいましたら、よろしくお願いいたします。

  • エクセルのVBAについて教えてください。

    エクセルのVBAについて教えてください。 下記のような構文で、Dの行にAやBの文字が入力された時、その都度 セルの色が変わるようにはできたのですが、本当は、「C5」セルに文字が 入力された時、「C5」だけでなく「B5:J5」の範囲でセルの色を変えたい のですが、どうすれば良いのでしょうか。 ご存知の方是非教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer If Target.Count > 1 Then Exit Sub If Target.Column <>4 Then Exit Sub Select Case Target.Value Case "A" myColor = 34 '水色 Case "B" myColor = 40 '肌色 Case Else myColor = xlNone End Select Target.Interior.ColorIndex = myColor End Sub

  • VBA セルの色を変更する

    VBA(エクセル2007使用)で、セルの背景色を変更する場合についての質問です。 マクロを実行する度に、セルの背景色を変更するマクロを作成しました。 オレンジ→水色→緑→灰色→無色  という風に変わっていくところまでは できたのですが、これだとマクロを実行するのにセルの状態が無色か、指定した カラーコードで塗りつぶされていないと実行できません。 下記、コードの一番最初の Case で ”背景色がどんな色の場合でも”という条件に したいのですが、どのように記載したらわからずにいます。。。 ---------------------------- Sub 色チェンジ() n0 = ActiveCell.Interior.ColorIndex Select Case n0 Case xlNone   ’ここを”どんな色の場合でも、、、という条件にしたいです。。” Selection.Interior.ColorIndex = 40 Case 40 Selection.Interior.ColorIndex = 34 Case 34 Selection.Interior.ColorIndex = 35 Case 35 Selection.Interior.ColorIndex = 15 Case 15 Selection.Interior.ColorIndex = xlNone End Select End Sub -----------------------------------

  • excel vbaについてです

    VBA初心者で、暇な時にいろいろためしています。 以下のマクロを組んだのですが、エラーがでてうまくいきません。 どこがいけないのかご指摘願います。 Sub ather() Dim A As Range Dim B As Range Dim i As Integer With ThisWorkbook.Worksheets("Sheet1") For i = 1 To 30 Set A = Cells(i, 1) Set B = Cells(1, i) If Not .Range(A).Interior.ColorIndex = vbYellow Then GoTo port10 If Not .Range(B).Interior.ColorIndex = vbRed Then GoTo port10 .Range(B).Offset(, 1).Value = "○" port10: Next i End With End Sub イメージとしてはセルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤の時に、 赤色セルの右隣のセルに○を表示させようとしているのですが。。。 こうしたらいいんじゃない?といったアドバイスもお願いします(-人-)

  • エクセルVBA 選択した値でセルの色を変える方法

    エクセルのVBAです。 指定されたセルの値をプルダウンで選択し、入力(選択)された値によって同じ列の指定した範囲に色を付ける、という内容です。 これを、一つの列のみで行う場合は、以下のコードでOKでした。 わからないのは、列の範囲が5~40まであり、それぞれ値を選択した時にそのセルと同じ列の指定範囲に色をつけることです。 ちなみに、条件付き書式は、すでに条件がいくつかついているため 使用できないという前提でお願いします) ちょっと説明がわかりづらいですが、おわかりになる方いらっしゃいましたら教えてください。よろしくお願いします!! ・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・ Private Sub Worksheet_Change(ByVal Target As Range) a = Cells(33, 5).Value Select Case a Case "A" Range("E6:E31").Interior.ColorIndex = 6 Case "B" Range("E6:E17").Interior.ColorIndex = 8 Range("E18:E31").Interior.ColorIndex = 2 Case "C" Range("E18:E31").Interior.ColorIndex = 8 Range("E6:E17").Interior.ColorIndex = 2 Case "" Range("E6:E31").Interior.ColorIndex = 2 End Select End Sub ・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・ Cells(33, 5)で A を選択した時は、E6:E31を黄色で。 B を選択した時は、E6:E17を水色かつE18:E31を白 C を選択した時は、E18:E31を水色かつE6:E17を白 値なしを選択した時は、色なし(白)

  • エクセルVBAのイベントで質問です。

    ある範囲のセルの色をダブルクリックにより変えていますが、 下の("D5:D50,F5:F50,K5:K50,M5:M50"))の範囲を例えばSheet1の A2以下に始めの範囲、B2以下に終りの範囲を下に書いていって、 対象とする範囲を可変にしたいのですが、どのようにすれば いいでしょうか。 例えば("D5:D50,F5:F50,K5:K50,M5:M50"))であれば A2に「D5」 B2に「D50」 A3に「F5」 B3に「F50」 などとセルにセル番地をいれておいて、コードを変えなくても シート上で範囲を変えていけるようにできないでしょうか。 やり方があれば教えてください。 よろしくお願いします。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim r As Range Set r = Intersect(Target, Range("D5:D50,F5:F50,K5:K50,M5:M50")) If r Is Nothing Then Exit Sub With r.Interior If .ColorIndex = xlNone Then .ColorIndex = 3 ElseIf .ColorIndex = 3 Then .ColorIndex = 4 ElseIf .ColorIndex = 4 Then .ColorIndex = xlNone End If End With Cancel = True End Sub

専門家に質問してみよう