マクロとセル保護に関して

2023/08/16 06:29

このQ&Aのポイント

勤務シフトを組むためにエクセルを利用しています。1列目には勤務時間を表す番号、2列目には関数を使って勤務時間を表示しています。マクロを使用して1という番号のセルを緑色、3という番号のセルを紫色に変更しています。しかし、2列目を保護して1列目に数字を入力するとエラーが発生します。
1列目は月によって変更するため、毎回打ち込めるようにしたいですが、2列目は1列目の数字に応じて変更されます。2列目を保護し、打ち込めないようにすると実行時エラーが発生します。
エラーの内容を確認すると、Target.Interior.ColorIndex = myColor の部分でエラーが発生しているようです。詳しい原因や解決方法が分からないため、助けていただきたいです。

ベストアンサー

マクロとセル保護に関して。

2012/04/29 12:15

いつも勉強させていただいています。現在、勤務シフトを組む為エクセルを利用しています。表に記載しているのはおおむねこのような感じです 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 この部分にマークが入ります。いろいろと調べつつ直そうとしたのですが、私ではわからなくなってきたのでどなたかお手すきの方がいらしたら、教えていただければと思います。

redash
お礼率100% (8/8)

その他MS Office製品
回答数1
ありがとう数1

みんなの回答 （1）
専門家の回答

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

ベストアンサー

aoumiushi
ベストアンサー率45% (234/512)

2012/04/29 13:53 回答No.1

1列目（数値を入力）の「セルの書式設定」で、「保護」タブ内の「ロック」のチェックを外す。シートの保護で「セルの書式設定」にチェックを入れてみる。以上でいかがでしょうか？

質問者

お礼 2012/04/29 14:15

早急なお答えありがとうございました！できました。これでおっちょこちょいな私も、安心してシフトを作成することができます。ありがとうございました。

関連するQ&A

EXCEL マクロ　条件によるセルの色付け
お世話になります。マクロは初心者です。 C列の数値1～6によって、E列に色付けしたく、ネットで色々検索して、下記のように組んだのですがコマンドボタンクリックでは上手く動かないのですが、どのように修正すればよいのでしょうか。教えて下さい。宜しくお願いします。 Private Sub CommandButton4_Click() Dim i As Range Dim r As Range Dim c As Range Dim myColor As Long Set i = Worksheets("マスタ").Range("C:C") Set r = Worksheets("マスタ").Range("E:E") If Intersect(Target, i) Is Nothing Then Exit Sub For Each c In Intersect(Target, i) With c Select Case .Value Case "1" myColor = 22 Case "2" myColor = 44 Case "3" myColor = 6 Case "4" myColor = 43 Case "5" myColor = 41 Case "6" myColor = 24 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, r).Interior.ColorIndex = myColor End With Next End Sub
- ベストアンサー
- その他MS Office製品
マクロで条件付き書式（セルの塗りつぶし）
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
- ベストアンサー
- オフィス系ソフト
塗りつぶしをしたセル色を特定のセルのフォント文字に
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Protect UserInterfaceOnly:=True Dim mycolor If Target.Column Mod 1 = 0 And Target.Column >= 4 And Target.Column <= 24 Then mycolor = Target.Interior.ColorIndex Range("B5:B38").Font.ColorIndex = xlAutomatic Range("B" & Target.Row).Font.ColorIndex = mycolor Else mycolor = xlAutomatic Range("B5:B38").Font.ColorIndex = xlAutomatic End If End Sub お世話になります、このコードは列D～Uまでの４～２４列の特定の箇所のセルを塗りつぶしにしています。その塗りつぶしたセルを選択されているとB５～B38に記入されている文字が塗りつぶされた文字と一緒になると言うVBAです。質問がいくつかあります。 (1)D列～U列の３８行目以降のセルを選択すると「FontクラスのColor Indexプロパティを設定出来ません。」となります。多分B３８以降にはセルが塗りつぶしされておらず、B３８以降に文字が書かれていないのでエラーとなってしまうのではないかと思います。これの解決策はありますか？ (2)E５～E38のセルのどこでも良いので数字を入力したら、E5～E38が同じ数字に自動変換するVBAは出来るのでしょうか？ (3)同じようにT５～T38のセルのどこでも良いので数字を入力したら、T5～T38が同じ数字に自動変換するVBAは出来るのでしょうか？ (4)同じようにD６～D38のセルのどこでも良いので数字を入力したら、D６～D38が同じ数字に自動変換するVBAは出来るのでしょうか？
- ベストアンサー
- Excel（エクセル）
[VBA] セルの色を塗りつぶす
条件付き書式では出来ないみたいなので、VBAに挑戦しましたが苦労しています。 Win 8, excel 2010です。「ある１つのセルが100の時、その左横の4列をある色で塗りつぶす」という事を行いたいのですが、ネットで調べたものをちょっとアレンジしてみましたが Sub change(ByVal Target As Range) Dim myColor As Variant If Target.Count <> 1 Then Exit Sub If Target.Column <> 4 Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case 100 myColor = 3 Case Else myColor = xlNone End Select Cells(Target.Row, 1).Resize(1, 4).Interior.ColorIndex = myColor Application.EnableEvents = True End Sub change(関数名)の横に引数があるから(参照渡し？？？) マクロに表示されないという情報を見つけたのですが、色々やっても訳が分からなくなりました。どうすれば実行できるようになるのでしょうか？
- ベストアンサー
- Visual Basic
ドラッグした際のエラー回避
以下のような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
セルの塗りつぶしマクロを作ったのですが・・
初めて投稿します。どうぞよろしくお願いします。エクセルの条件付き書式では4通りにしか設定できないため、マクロ初心者ではありますが、こちらでの回答を参考に作ってみました。 0～0.999　薄ピンク 1～1.999　ピンク 2～2.999　赤 3～3.999　オレンジ　　↓ 　　↓ 25～25.999　濃い紫と26パターンに自動的に塗りつぶすマクロを作りました。ところが空白のセルも0～0.999で指定している薄ピンクに塗りつぶされてしまいます。何分初心者なもので、どこを修正したら良いのかわかりません。どなたかアドバイス頂けると助かります。よろしくお願いします。 Sub color0_25() Dim Target As Range For Each Target In Range("A1:Z1000") Select Case Target.Value Case Is < 0 Target.Interior.ColorIndex = 0 Case Is < 1 Target.Interior.ColorIndex = 38 Case Is < 2 Target.Interior.ColorIndex = 7 Case Is < 3 Target.Interior.ColorIndex = 22 Case Is < 4 Target.Interior.ColorIndex = 3 Case Is < 5 Target.Interior.ColorIndex = 46 Case Is < 6 Target.Interior.ColorIndex = 45 Case Is < 7 Target.Interior.ColorIndex = 44 Case Is < 8 Target.Interior.ColorIndex = 6 Case Is < 9 Target.Interior.ColorIndex = 36 Case Is < 10 Target.Interior.ColorIndex = 35 Case Is < 11 Target.Interior.ColorIndex = 4 Case Is < 12 Target.Interior.ColorIndex = 50 Case Is < 13 Target.Interior.ColorIndex = 14 Case Is < 14 Target.Interior.ColorIndex = 34 Case Is < 15 Target.Interior.ColorIndex = 37 Case Is < 16 Target.Interior.ColorIndex = 33 Case Is < 17 Target.Interior.ColorIndex = 28 Case Is < 18 Target.Interior.ColorIndex = 41 Case Is < 19 Target.Interior.ColorIndex = 5 Case Is < 20 Target.Interior.ColorIndex = 11 Case Is < 21 Target.Interior.ColorIndex = 55 Case Is < 22 Target.Interior.ColorIndex = 17 Case Is < 23 Target.Interior.ColorIndex = 39 Case Is < 24 Target.Interior.ColorIndex = 54 Case Is < 25 Target.Interior.ColorIndex = 13 Case Is < 26 Target.Interior.ColorIndex = 21 End Select Next End Sub
- ベストアンサー
- オフィス系ソフト
エクセルVBA SelectCaseを使用したい
エクセル勉強中の者です。 SelectCaseを使って特定セルの色を変えたいのですが上手く動作しません。目的の動作１：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 = Intersect(Target, Range("B1:B6")) If Not mycolor Is Nothing Then For Each mycolor In Target Select Case Target.Value Case Is = 1 boxcolor.ColorIndex = 3 Case Is = 2 boxcolor.ColorIndex = 5 Case Is = 3 boxcolor.ColorIndex = 4 Case Is = 4 boxcolor.ColorIndex = 6 Case Else boxcolor.ColorIndex = xlAutomatic End Select Next mycolor End If End Sub 実行するとSelect Caseの最初で止まってしまいます。何だか変数を上手く指定出来ていないような・・・？色々と調べて手を加えてみましたが成功に至りませんでした。お手数掛けますが御指導お願い致します。ちなみに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
イベントマクロについて
イベントマクロについて質問ですがまず、下記をご覧下さい。過去にここで回答いただいたものを流用させてもらったものですがもうひとつ機能を追加したいと思います。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column >= 4 And Target.Column <= 34 Then If Target.Row >= 2 And Target.Row <= 100 Then Select Case Target Case "(5)GC" Target.Interior.ColorIndex = 34 Target.Font.ColorIndex = 0 Case "6OS", "6FC" Target.Interior.ColorIndex = 6 Target.Font.ColorIndex = 0 Case "(6)TA", "(6)C" Target.Interior.ColorIndex = 46 Target.Font.ColorIndex = 0 Case "6@BD", "6@C" Target.Interior.ColorIndex = 38 Target.Font.ColorIndex = 0 End Select End If End If End Sub 追加する機能とは、上記で指定した範囲以外のセルを参照して色を付けるかどうかを区別するものです。例えば、A2の値が色付けに該当する場合はD2からAH2の中で上記マクロに該当するセルに色を付け、もしA2が該当しない場合は色付けをしないというような感じです。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
マクロでの条件付書式について
私は、下記のような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
- ベストアンサー
- オフィス系ソフト