- ベストアンサー
[VBA] セルの色を塗りつぶす
kagakusukiの回答
- kagakusuki
- ベストアンサー率51% (2610/5101)
>条件付き書式では出来ないみたいなので え? 出来ないという事はないと思います。 例えば「100」と入力するセルがE2:Z999のセル範囲の中のどこかのセルである場合、次の様な操作を行って条件付き書式を設定すれば良いと思います。 A2セルを選択 ↓ Excelウィンドウの[ホーム]タブをクリック ↓ 現れた「スタイル」グループの中にある[条件付き書式]ボタンをクリック ↓ 現れた選択肢の中にある[ルールの管理]をクリック ↓ 現れた「条件付き書式ルールの管理」ダイアログボックスの中にある[新規ルール]ボタンをクリック ↓ 現れた「新しい書式ルール」ダイアログボックスの「ルールの種類を選択して下さい」欄の中にある[数式を使用して、書式設定するセルを決定]をクリック ↓ 現れた「次の数式を満たす場合に値を書式設定」欄の中に =COUNTIF(B2:E2,100) と入力 ↓ 「新しい書式ルール」ダイアログボックスの[書式]ボタンをクリック ↓ 現れた「セルの書式設定」ダイアログボックスの[塗りつぶし]タブをクリック ↓ 現れた背景色のサンプルの中にある赤色の四角形をクリック ↓ 「セルの書式設定」ダイアログボックスの[OK]ボタンをクリック ↓ 「新しい書式ルール」ダイアログボックスの[OK]ボタンをクリック ↓ 「条件付き書式ルールの管理」ダイアログボックスの「適用先」欄に設定されているセル範囲を =$A$2:$V$999 に変更（カーソルとマウスの左ボタンによる範囲選択が使えます） ↓ 「条件付き書式ルールの管理」ダイアログボックスの[適用]ボタンをクリック ↓ 「条件付き書式ルールの管理」ダイアログボックスの[OK]ボタンをクリック
関連するQ&A
- ドラッグした際のエラー回避
以下のようなVBAを組んだのですが、オートフィルタでV列をリストのいずれかを選択中にドラッグすると「型が一致しません」というエラーを起こします。 最悪、オートフィルタ中はドラッグ不可でもかまいません。 ご教授ください。 （WiｎXp/Access2003) Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) '列の色変更 Dim myColor As Variant Dim myFontColor As Variant If Target.Column = 1 Then GoTo S If Target.Column = 9 Then GoTo K If Target.Column = 25 Then GoTo Y If Target.Column = 22 Then GoTo A If Selection.Cells.Count > 1 Then Exit Sub Exit Sub S: 'A列入力時 If Not Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value <> "" And Target.Offset(0, 4) = "" And Target.Offset(0, 2) = "" Then Target.Offset(0, 2) = "TypeA" Target.Offset(0, 5) = "未" Target.Offset(0, 6) = Date Target.Offset(0, 1).Select End If Application.EnableEvents = True Exit Sub K: '故障入力時 If Not Intersect(Target, Range("K1:K10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value = "Y" Then Target.Offset(0, 13) = "故障" Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 7 Target.Offset(0, 1).Select Else End If Application.EnableEvents = True Exit Sub Y: 'Y列入力時 If Not Intersect(Target, Range("Y1:Y10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value <> "" And Target.Offset(0, 1) = "" And Target.Offset(0, 2) = "" Then Target.Offset(0, -3) = "売却済" Target.Offset(0, 1) = Date Target.Offset(0, 2) = "未" Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 16 Else End If Application.EnableEvents = True Exit Sub A: If Not Intersect(Target, Range("A1:AB10")) Is Nothing Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case "故障" myColor = 7 'ピンク myFontColor = 1 Case "修理中" myColor = 37 '薄い水色 myFontColor = 1 Case "担当出(1)" myColor = 3 '赤 myFontColor = 1 Case "担当出(2)" myColor = 8 '水色 myFontColor = 1 Case "担当出(3)" myColor = 4 '蛍光緑 myFontColor = 1 Case "担当出(4)" myColor = 6 '黄色 myFontColor = 1 Case "担当出(5)" myColor = 5 '青 myFontColor = 1 Case "担当出(6)" myColor = 10 '深緑色 myFontColor = 1 Case "売却済" myColor = 16 '濃灰色 myFontColor = 1 Case "廃棄", "修理不可能" myColor = 47 '群青 myFontColor = 2 '白 Case "保守用" myColor = 49 '群青 myFontColor = 2 '白 Case Else myColor = xlNone End Select Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = myColor Cells(Target.Row, 1).Resize(1, 28).Font.ColorIndex = myFontColor Application.EnableEvents = True End Sub Private Sub AFall() If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If End Sub
- 締切済み
- Visual Basic
- VBAで作業を作成したものを別の列に適用するには
教えてください。 マクロ初心者ですが、色々なところから検索してI列に文字が入力されるとJ列に自動で 明日の日付が入るようにまた、入力したIとJのセルを色つけまで完成させました。 次の列以降にも同じ作業を行いたいときのVBAを教えてください。 （「KとL」「MとN」に同じ処理をしたい場合） ループ処理など見たのですが、行のようでよくわかりませんでした。 ちなみに作成したVBAがこちらです。 Private Sub Worksheet_Change(ByVal Target As Range) With Target If Application.Intersect(Range("I1:I100"), Target) Is Nothing Then Exit Sub If .Count > 1 Then Exit Sub If IsEmpty(.Value) Then .Offset(, 1).ClearContents Else .Offset(, 1).Value = Date+1 End If End With Dim myColor As Variant Dim c As Range Dim myRng As Range Set myRng = Application.Intersect(Range("I:I"), Target) If myRng Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In myRng Select Case c.Value Case 1 myColor = 36 Case 2 myColor = 38 Case 3 myColor = 40 Case 4 myColor = 39 Case 5 myColor = 34 Case 6 myColor = 35 Case Else myColor = xlNone End Select Cells(c.Row, 9).Resize(1, 2).Interior.ColorIndex = myColor Next c Application.EnableEvents = True End Sub よろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- エクセルの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
- ベストアンサー
- Visual Basic
- マクロとセル保護に関して。
いつも勉強させていただいています。 現在、勤務シフトを組む為エクセルを利用しています。 表に記載しているのはおおむねこのような感じです 1列目：勤務時間を表す番号（1＝早出 2＝遅出といった感じで番号のみを入れています） 2列目：勤務時間を関数で表示（ =IF(E12=1,7.75,(IF(E12=2,7.75,(IF(E12=3,7.75,(IF(E12=4,14.75,(IF(E12="有",7.75,(IF(E12="明",0,))))))))))) ）これで1列目に1という数字が入った場合、7.75となり横計に数字を用いています。 これがスタッフの人数分あります。 1列目で1という番号が打ち込まれた際には緑色、3という番号が打ち込まれた際には紫いろといったマクロを使用しています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myColor As Integer If Target.Count > 1 Then Exit Sub Select Case Target.Value Case 5 myColor = 38 'ローズ色 Case 2 myColor = 40 'ベージュ色 Case "明" myColor = 36 '黄色 Case 1 myColor = 35 '緑色 Case 4 myColor = 34 '青色 Case 3 myColor = 39 'ラベンダー Case "有" myColor = 37 '緑色 Case "F" myColor = 43 'ライム Case "6" myColor = 17 'コーラル Case Else myColor = xlNone End Select Target.Interior.ColorIndex = myColor Target.Font.ColorIndex = 0 End Sub 上記のようにコードを記入しています。 さて。 1列目は月により変更するために、毎回打ち込めるようにしておきたいのですが 2列目は1列目の数字を受けて変更されますよね。 2列目を保護し、打ち込めないようにした場合、1列目に数字を入れると 実行時エラー’1004’： アプリケーション定義またはオブジェクト定義のエラーです と出てしまいます。 デバックを見ると Target.Interior.ColorIndex = myColor この部分にマークが入ります。 いろいろと調べつつ直そうとしたのですが、私ではわからなくなってきたのでどなたかお手すきの方がいらしたら、教えていただければと思います。
- ベストアンサー
- その他MS Office製品
- VBAでのセルの複数選択時の処理について
現在EXCEL VBAである行の値が変わったときにその列の塗りつぶしの 色を変えるといった処理を作成しております。 そこで、複数選択して値を変えた場合の処理が変数の型が一致しません 的なエラーが表示されてしまいます。 どのように修正したらうまくいくでしょうか？ 教えてください。 ソースは下記の通りとなります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 13 Then Exit Sub Application.EnableEvents = False MsgBox (Target.Rows.Count) Dim rngSelectRng As Range For Each rngSelectRng In Target If rngSelectRng.Value = "" Then rngSelectRng.Value = " " 'ステータス欄の入力の判断 'Select Case Target.Rows.Value MsgBox (Target.Row) Select Case rngSelectRng.Value Case "あああ" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 24 Case "いいい" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 35 Case "ううう" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 38 Case "えええ" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 36 Case "おおお" Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 16 Case Else Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 2 End Select Next Application.EnableEvents = True End Sub
- ベストアンサー
- Visual Basic
- VBAでセルの色付を別の列にも追加するには
WINDOWS XP EXCELL ２００３です。 いつもお世話になります。 現在下記の如く、 A列にマクロを設定しています。 ※A F列には下記の数式が入っています。 A2 =IF(B2="","",TEXT(B2,"mm")) F2 =IF(G2="","",TEXT(G2,"mm")) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, -1).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 上記のマクロに追加でF列にも同様にセルの色付けするにはどうすればいいか ご教授を御願いできないでしょうか。
- ベストアンサー
- その他MS Office製品
- VBAのセルの色の設定について
EXCEL・VBAにて.Interior.Color=RGB(152, 251, 152)と設定しましたが 思った色(緑系の色)ではなくグレー系の色になってしまったのですが、 何か間違っているのでしょうか？ 何かわかる方いらっしゃいますでしょうか？ 実際のソースはしたの通りとなります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 13 Then Exit Sub Application.EnableEvents = False 'ステータス欄の入力の判断 Select Case Target.Value Case "あああ" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(152, 251, 152) Case "いいい" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(254, 208, 224) Case "ううう" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(255, 255, 0) Case "えええ" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(192, 192, 192) Case Else Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(255, 255, 255) End Select Application.EnableEvents = True End Sub
- ベストアンサー
- Visual Basic
- Worksheet_Changeが動かない
エクセル自動実行のマクロを作成中にうまく動かないので サンプルをコピーして、変更してみたのですが そのサンプルも動いません、マクロとは違う何か悪いのでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim intColor As Integer If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("B2:B11")) Is Nothing Then Exit Sub Select Case Target.Value Case Is <= 20 intColor = 3 Case 21 To 40 intColor = 46 Case 41 To 60 intColor = 9 Case 61 To 80 intColor = 10 Case Is > 80 intColor = 5 End Select Target.Font.ColorIndex = intColor Application.EnableEvents = True End Sub
- ベストアンサー
- その他MS Office製品
- エクセルで特定の文字列の含まれるセルのある行の色を変更したいと思ってお
エクセルで特定の文字列の含まれるセルのある行の色を変更したいと思っておりますが、関数では出来ないようなので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シート分の設定に書かれているようです。。。 全シートに反映がされるように設定をするにはどこをどのように書き換えればよろしいでしょうか。 お分かりの方がいらっしゃいましたら、よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- マクロで条件付き書式（セルの塗りつぶし）
2003のため、条件付書式を5つ作るのにマクロが必要なのですが触ったことないので全くわかりません。以下のマクロ作ったのですが、"コンパイルエラー End Subが必要です"と出てしまいます。どこが悪いのか見当も付きません（TT）。添削をお願いします。 やりたいことは、「決まっている範囲内に入力されている単語別にセルの色を分ける」です。 Sub 条件() Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Set rng = IntersectC9: F28 If rng Is Nothing Then Exit Sub Dim x As Range For Each x In rng Dim myColor As Integer Select Case x.Value Case "りんご": myColor = 3 '赤色 Case "ばなな": myColor = 45 'オレンジ色 Case "みかん": myColor = 6 '黄色 Case "いちご": myColor = 5 '青色 Case "他": myColor = 4 '緑色 Case Else: myColor = xlNone End Select x.Interior.ColorIndex = myColor Next x Set rng = Nothing Set x = Nothing End Sub
- ベストアンサー
- オフィス系ソフト