エクセルVBAで条件付きの背景色を設定する方法
- エクセルVBAを使用して、特定の条件下でセルの背景色を設定する方法を知りたいです。
- 条件付き書式を使用して、エクセルのI列の背景色を設定しましたが、特定の条件下で背景色が設定されない場合、行の他のセルの背景色も設定する方法を学びたいです。
- エクセル2010を使用していますが、VBAの知識が不足しているため、具体的なアドバイスやガイドを求めています。
- ベストアンサー
背景を条件付きで色を付けたい
Sub test() Dim Rng As Range For Each Rng In Range("I7:I756") If Rng.Interior.ColorIndex = xlNone Then Cells(Rng.Row, 1).Resize(, 6).Interior.ColorIndex = 35 End If Next End Sub 上記のコードだとうまくいきません>< データベースがA7:K756まであり、I 列の背景が何もない場合のみ その行のAからFまでのセルを薄い緑の背景にしたいのです。 例えばI10の背景がない場合はA10.B10.C10.D10.E10.F10のセルを薄い緑する といった感じにしたいのですがVBAはあまり詳しくないので 詳しい方ぜひアドバイスお願いします。 エクセル2010を使っています。 補足 I列の背景は条件付き書式で色付けしています。
- ryutahayashi
- お礼率75% (24/32)
- Visual Basic
- 回答数2
- ありがとう数2
- みんなの回答 (2)
- 専門家の回答
質問者が選んだベストアンサー
条件つき書式で変えたセルの色の値が返ってきませんね。 エクセルの仕様だと思います。 ためしに以下のマクロを実行すると 条件を満たしていても-4142(=xlNone)が戻ってきます。 Sub test3() Dim Rng As Range For Each Rng In Range("I7:I756") Debug.Print Rng.Address & " " & Rng.Interior.ColorIndex Next End Sub 対応方法としては、 If Rng.Interior.ColorIndex = xlNone Then のところを If Rngの条件=True Then にすればよいでしょう。
その他の回答 (1)
- mu2011
- ベストアンサー率38% (1910/4994)
>I列の背景が何もない場合その行のAからFまでのセルを薄い緑の背景にしたいのです。 ⇒I列が条件付き書式でセル背景が変化している場合、このコードでは確認できません。 よって、I列の色の有無を判定ではなく、色付けされる条件で判定すべきですね。
お礼
ご指摘ありがとうございました。 考えてやってみます。
関連するQ&A
- 複数セル参照で塗りつぶしを変更する
WIN:XP Off:2003 お願いします。 添付した図は入出金表です。 列Hに数値が入力されると列Eのセルが青く塗りつぶされます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Dim aCell As Range Set Rng = Intersect(Target, Range("H:H")) If Rng Is Nothing Then Exit Sub For Each aCell In Rng If aCell.Value > 0 Then aCell.Offset(0, -3).Interior.ColorIndex = 17 Else aCell.Offset(0, -3).Interior.ColorIndex = xlNone End If Next aCell Set Rng = Nothing End Sub ここまでは出来たのですが、列Iに入力された時に列Eが赤に塗りつぶされるにはどうしたらいいでしょうか? 同じ行のHとIに同時に数値が入る事はありません。 どうかお願い致します。
- ベストアンサー
- Visual Basic
- シート全体対象の設定方法と複数のセル範囲の参照方法
ブック名「全体.xls」の全シート対象に、 (A1:B10) (D1:F10)の範囲だけの数値を調べ、 その数値が50以上のときに背景色を赤色にするマクロを作りたいですが。 Sub セルの値が50以上の時、背景色を赤色にする() Dim i As Integer i = ActiveCell.Value With ThisWorkbook("全体").Range("A1,B10") If i >= 50 Then ActiveCell.Interior.ColorIndex = 3 Else ActiveCell.Interior.ColorIndex = xlNone End If End With With ThisWorkbook("全体").Range("C1,F10") If i >= 50 Then ActiveCell.Interior.ColorIndex = 3 Else ActiveCell.Interior.ColorIndex = xlNone End If End With End Sub こうしても、 With ThisWorkbook("全体").Range("A1,B10") のところでエラーではじかれます。シート全体の("A1,B10")を対象にしたいですが、指定方法が分かりません。 ちなみにシート数は追加・削除あるので一定ではないです。 また、("A1,B10")と("C1,F10")にて個別にコードを書くのではなく 同時に設定したいけれど、(.Range("A1,B10")&("C1,F10")みたいな) やり方を知りたいです。 初歩的な質問で申し訳ありません。よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセル 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の同じセルの色もかわるのでしょうか? 宜しくお願いいたします
- ベストアンサー
- オフィス系ソフト
- シート保護をすると実行エラーになります。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("A1:A2000")) Is Nothing Then Exit Sub With Selection.Interior If .ColorIndex = xlNone Then .ColorIndex = 4 Else .ColorIndex = xlNone End If End With Cancel = True End Sub A列任意のセルをダブルクリックすると色が変わるコードを組んでいます。しかしながら、 A列のみロックを解除したのち、シート保護をすると、上記の実行がエラーになります。 どのようにすればエラーを回避できるのかお知恵をかしていただければ幸いです。
- ベストアンサー
- オフィス系ソフト
- エクセルですが・・・。
チェックボックスについてです。 Private Sub CheckBox1_Click() If CheckBox1 Then Range("F1:F6").Interior.ColorIndex = 3 Else Range("F1:F6").Interior.ColorIndex = xlNone End If End Sub 以前、上記のように教えていただいたのですが、 これですと、1行しか設定していませんよね? これを、例えば100行くらい自動で設定できませんか? 宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- 調子よく使用していたコードが、急にエラーに!
Windows XP Home Edition Excel 2002 つい最近、ご回答して頂いたコードです。 オートフィルタ(▼)がかかった、直上のセルに色を付けるために使用しておりました。 どの行でも、どこでも実行できておりました。 大変、調子がよく使用していたのですが、 本日、下記のようにエラーとなり、動作しなくなってしまいました。 原因の一つは、 当方が、 EntireRowにてオートフィルタ(▼)をかけた場合に、 1、 256列全てにオートフィルタ(▼)がかかる。 2、 Range("A1").CurrentRegionのようにデータがある列までオートフィルタ(▼)がかかる。 のように、2通りの結果となります。 1の時にエラーとなるようです。 Range("A1").CurrentRegion にてオートフィルタ(▼)をかけた場合は、 下記コードはきちんと動作します。 1となってしまうのは、当方の、ブックに何か原因があるのでしょうか。 1の場合でも動作させることはできますでしょうか。 当方のデータシートは、データがとんでいる所がありますので、 Range("A1").CurrentRegionでうまくオートフィルタ(▼)がかからない場合があります。 下記★箇所がエラーとなります。 一般的ではない質問かと思いますが、 何卒、ご教示お願い致します。 '------------------------------- 実行時エラー'424' オブジェクトが必要です。 と表示されます。 '------------------------------- Sub Worksheet_Calculate() Static rng As Range Dim i As Long Dim j As Long If ActiveSheet.AutoFilterMode Then With ActiveSheet.AutoFilter If .Range.Rows(1).Row = 1 Then 'タイトル行が1行目の場合 j = 0 Else j = -1 End If For i = 1 To .Range.Rows(1).Cells.Count If .Filters(i).On Then .Range.Rows(1).Offset(j, i - 1).Interior.ColorIndex = 33 Else .Range.Rows(1).Offset(j, i - 1).Interior.ColorIndex = xlNone '★ End If Next i Set rng = .Range End With Else If Not rng Is Nothing Then 'リセット(ただしできないことがある) rng.Rows(1).Offset(j).Interior.ColorIndex = xlNone End If Set rng = Nothing End If 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 -----------------------------------
- ベストアンサー
- オフィス系ソフト
- 二つの条件式を一つにまとめようとしてます。
二つの条件式を一つにまとめようとしてます。 マクロを勉強しております。以前も質問させて頂いて、やりたい事は解決出来たのですが、更に別の事をしようと思いつまずきました。 A列の17行目まで数値が記入してあり、その順位をB列に記入するマクロを作りました。ここまでは何とか教えて頂いて出来たのですが。 さらに背景色が付いているセルを空欄にしてから順位を出そうとしました。それで、自分なりに記入して出来たのですが、この二つを一つにまとめようとしたらうまくいきません。Select case ~などを使用してみたのですが、よく分からなくなりました。どのようにしたらよいかだれか教えてください。 Sub Macro2() Dim r As Range Range("A1:A17").Select For Each r In Selection If r.Interior.ColorIndex <> xlNone Then r.Value = "" End If Next r End Sub Sub Macro1() Dim r As Range, a As Range Range("A1:A17").Select For Each r In Selection If r.Value <> "" Then r.Offset(, 1).Value = Application.WorksheetFunction.Rank(r, Selection, 1) End If Next r End Sub あと、Select しない書き方も研究してください。と指摘、頂いたのですがまだ未解決なので、そこはそのままになっております。
- ベストアンサー
- オフィス系ソフト
- マクロでの条件付書式について
私は、下記のようなO列の値を変更するとそれに伴ってセルの色が変化するマクロを作成しました。 下記の通りで、色は変わるのですが、 (1)セルO8をコピー (2)セルO9:O10を範囲選択 (3)貼り付け とすると 「型が一致しません」 というエラーがでてしまいます。 いろいろと調べたのですが、原因が分かりませんでした。 マクロに関しては、初心者で初歩的な事かも知れないのですがご教授お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("O8:O5000")) Is Nothing Then Exit Sub Select Case Target.Value Case Is = "連絡待ち" Target.Interior.ColorIndex = xlNone Case Is = "取引連絡中" Target.Interior.ColorIndex = 23 Case Is = "取置き" Target.Interior.ColorIndex = 3 Case Is = "入金連絡あり" Target.Interior.ColorIndex = 4 Case Is = "発送準備中" Target.Interior.ColorIndex = 7 Case Is = "発送待ち" Target.Interior.ColorIndex = 17 Case Is = "発送済み" Target.Interior.ColorIndex = 16 Case Else Target.Interior.ColorIndex = xlNone End Select End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルなんですが・・・
Private Sub CheckBox1_Click() If CheckBox1 Then Range("B5:F5").Interior.ColorIndex = 3 Else Range("B5:F5").Interior.ColorIndex = xlNone End If End Sub Private Sub CheckBox2_Click() If CheckBox2 Then Range("B6:F6").Interior.ColorIndex = 3 Else Range("B6:F6").Interior.ColorIndex = xlNone End If End Sub 度々の質問ですみません。上記のように設定するとチェックボックス1をチェックすると、B5~F5まで赤くなります。2をチェックするとB6~F6まで赤くなります。このような設定でチェックボックスを100まで作りたいのです。当然、チェックボックス3には、B7~F7までが、4にはB8~F8まで赤くなるように・・・と自動で CheckBox2 &("B6:F6").←この部分を変えるにはどのようにしたら良いのでしょう? あと、もう一つなんですが、エクセルで作成した表を共通ファイルに入れて、オリジナルは自分のデスクトップに置き、デスクトップのデータを変更したときに、リアルタイムで共通フォルダの表も、変更が反映されるにはどうしたら良いのでしょうか? 表現が良く伝わらなかったらごめんなさい。 どうか宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
詳しい説明ありがとうございました。 教えていただいたどうり変更して試したいと思います。