[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件により、セルを結合及びリスト設定』（miu）
いつもお世話になっております。
早速ですが、下記について教えて頂けないでしょうか？
セルA13に、ある数字が入力されるとセルC13〜N13を結合して、
入力規則のリスト設定で、y列（$y:$y)を範囲として設定する。
また、書式設定で結合したセルは縮小表示で全体を表示するようにして、
フォントサイズ「20」及び太字に設定をするようにしたいです。
（また、この条件に当てはめたいセルは、A13〜A21まであり、
結合するセルも、C13〜N13 〜 C21〜C21まであります。）
わかりづらいかもしれませんが、何卒宜しくお願いします。
[Excel2003、WindowsXP]
マクロをあまり理解していないので、難しい条件等がわかりません。
以下は、書式の設定等だけ作ってみました。
Range("c13:n13").MergeCells = True '----結合
With Range("c13")
.Font.Size = 20 '---フォント20にする
.Value = "Bold"
.Font.Bold = True '---太字にする
.Validation.Modify _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertWarning, _
Operator:=xlEqual, _
Formula1:="$y:$y" '---y列をリスト範囲に設定
.Validation.IgnoreBlank = True '---ブランクの入力を認めます
End With
また、セルA13〜a21までに数字が入力された場合の条件設定と
結合されたセルの書式設定で、縮小して全体表示の設定がわからないのと
、それを組合せて実際に使用できるようにしたいのですが、
教えて頂けないでしょうか？
宜しくお願い致します。
(すみません、「.Validation」が抜けてました。。。）
ちなみに、上記のリストの設定はエラーが出てしまうのですが
これについても、どこが間違ってるか教えて頂いても宜しいでしょうか？
面倒な注文ばかりで申し訳ありませんが、何卒宜しくお願い致します。
何か、マナー違反とか至らない点等ありましたら教えてください。
そんなことはないと思います。 きっと皆さんお忙しいのだと思います。 もしくは、質問の回答を考えていらっしゃる最中かもしれません。 私が分かればお答えするのですが、能力なくてすみませんm(__)m 今しばらくお待ち下さいね。。。 (代奈)
代奈さん、書き込みありがとうございます。
2〜3時間、誰からも書き込みいただけなかったので、
何か失礼な書き込みか何かしてしまったのかと、ちょっと泣きそうになってました。。。
もうすぐ、帰り支度の時間なので、また明日来て見ようと思います。
皆様、どうか上記の件何卒宜しくお願い致します。
この掲示板の回答者は専門で解答している方は（おそらく） いらっしゃいません。別に本業をお持ちの方々です。 つまりボランティアです。また、回答を考えるにもまとまった時間 が必要な時があるので、すぐにお答えできないケースもあります。 私も現在まとまった時間が取れない状態です。 だからたまに見受ける「急いでます！」なんて相談も無意味です。 （とくに[miu]さんの相談はマクロでもあるので検証が必要） このような相談掲示板では回答がつかなくてもせめてまる一日 様子を見るようにしてください。 トピックを修正して上のほうに上げる行為は 「私のを他の人より優先して！」と主張する身勝手な方と受け 取られかねません。あせらないでお待ちください。 （みやほりん）
だいたいこんな感じで出来るかと。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
If Application.Intersect(Target, Range("A13:A21")) Is Nothing Then Exit Sub
For Each r In Target
If Target.Value = "123" Then '←ある数字
'処理
Range(Cells(Target.Row, 3), Cells(Target.Row, 14)).Merge
End If
Next r
End Sub
(INA)
INAさんがすぐレス入れてくれたようです。
コーディングはINAさんのものを参考にされるといいでしょう。
さて、エラーの件だけ。
「実行時エラー：1004 アプリケーション定義またはオブジェクト
定義のエラーです」であると思いますが、
Modifyメソッドは既存のValidationオブジェクトに対する変更を行う
場合に実行するものです。つまり、入力規則が設定されていないセル
範囲を対象に実行すると上記エラーが表示されます。
（エクセル君の文句「ないものを変更せよとは何事か！」）
新規に入力規則を追加するにはAddメソッドを使いますが、
既に入力規則が設定されているセル範囲へAddメソッドを使用すると
同じく上記エラーが発生します。
（エクセル君の文句「既に存在するのに追加せよとは何事か！」）
ということで、いったんDeleteしてから、Addが無難。
.Validation.Delete
.Validation.Add _・・・
この場合、入力規則未設定セル範囲に対してDeleteしても
「入力規則が設定されていないのにクリアせよとは何事か！」とは
文句を言ってこないので、不思議ではある。
（みやほりん）
INAさんとみやほりんさんのおかげで、作ることが出来ました。
ありがとうございました。
ただ、1点だけ分からなかったのですが、縮小して全体表示をする設定は
HP等検索しても分からなかったのですが、これについて教えて頂けませんでしょうか？
宜しくお願いします。
一応、出来上がったマクロも載せますね。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim S As Integer
If Application.Intersect(Target, Range("A13:A21")) Is Nothing Then Exit Sub
For Each r In Target
If Not Target.Value = "" Then '←数字が入力された時
'処理
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
.Merge
.Font.Size = 20 '---フォント20にする
.Value = ""
.Font.Bold = True '---太字にする
End With
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14)).Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=$y:$y"'---入力規則をY列に設定
End With
End If
Next r
End Sub
記録してみました。
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = True
.MergeCells = False
End With この中の、多分
.ShrinkToFit = True
だと思いますが。。。
(代奈)
試してみたら、きちんと縮小表示なりました。ありがとうございました。
また、質問なんですが、今の状態でセルA13〜A21の中の複数のセルを選択した状態でデリートキーを押すと
エラーが出て型が一致しませんと出るのですが、エラーの回避の方法教えて頂いても
宜しいでしょうか？
度々、注文してしまい申し訳ありませんが、何卒宜しくお願い致します。
（miu）
VBAむずいですよね(ーー;)
On Error GoTo Error処理 If〜 処理 End If Error処理: End Sub
形的にはこんな風になるんでしょうけど、 エラーの時にどうしたいかによって「:」以降が違うんですよね。。。 先生方の回答を一緒に待ちましょう(^^) (代奈)
私が間違えてました。For each の中では、target→ r です。
Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range Dim S As Long
If Application.Intersect(Target, Range("A13:A21")) Is Nothing Then Exit Sub
For Each r In Target
If Not r.Value = "" Then '←数字が入力された時
'処理
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.Merge
.Font.Size = 20 '---フォント20にする
.Value = ""
.Font.Bold = True '---太字にする
End With
With Range(Cells(r.Row, 3), Cells(r.Row, 14)).Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=$y:$y" '---入力規則をY列に設定
End With
End If
Next r
End Sub
ちなみに数値かどうかの判定は、Isnumeric関数で出来ますよ。 あと入力した後、削除したら結合解除とか必要ないのでしょうか・・・？ (INA)
VBA難しいですよね。。。
ここで質問をして、初めてVBAを知ってその時にINAさんにVBAのHPをいくつか
紹介して頂き、少しずつ勉強してるところです。
とりあえず、複数セルを選んで入ってる文字を消せれば良いのですが、
欲を言うと消した時に、結合と入力規則を解除できるともっと良いのですが。。。
先生方、お忙しい所大変申し訳ありませんが、何卒宜しくお願いします。
（miu）
お返事ありがとうございます。
ちょうど、今書き込みしてたのですが、そうなんです！結合解除と入力規則を解除できる
と非常に助かります。。。
度々、申し訳ありませんが宜しくお願いします。
P.S.数値かどうかの判別なんですが、空白か数字しか入らないのですが、Isnumeric関数というのを
使ったほうが良いですか？
（miu）
「A13〜A21」と「C13〜N13」〜「C21〜C21」以外をシート保護したいのですが
手動で設定するとエラーが出てしまうのですが、これもマクロ上で設定しないと設定できないのでしょうか？
いろいろ注文してしまい申し訳ありませんが、宜しくお願い致します。
（miu)
専門的なことは置いといて、と(笑) >>手動で設定するとエラーが出てしまうのですが いったん、ブックを閉じて、次にマクロ無効で開いて保護するとか(ーー;) (代奈)
代奈さん、お返事ありがとうございます。 マクロが利いてる時に、他のセルに数式とか入ってるので、 間違って消さないように保護したいんです。。。 せっかくアドバイスいただいて申し訳ないんですが・・・。 わがまま言ってすみません。。 （miu)
んんん。 わかんないときは、マクロの記録を使ってみるといいと思います(^^) 今日は私、そろそろタイムアップです(>_<) また明日、お邪魔してみますね！ miuさん、ふぁいとっ(代奈)
ちょっといま、他所のドラえもんで忙しいので、すみません。 どなたかフォロー出来る方いませんか〜？ また後ほど来ます。 (INA)
おはようございますm(__)m
>> マクロが利いてる時に、他のセルに数式とか入ってるので、 >>間違って消さないように保護したいんです。。。
↑ この方法で、シートにあらかじめ保護をかけておけばいいのかなって思ったのです。。。 (代奈)
おはようございます。 こんな簡単な保護の仕方があったんですね！ ただ、手動で保護の設定というのが、結局自分で数式の入っているセルを 保護に設定してるので同じ結果になってしまいます。（一応、試してみたのですが同じエラーが。。。） せっかくのアドバイスだったんですが、すみません。。。 ちなみに、結合と入力規則の解除は、やっぱりすごく難しいんですよね・・・。（冷汗） （miu)
スキルなくてごめんなさい(T_T) シートを再現しようと頑張っているのですが、上のコードを貼り付けても 私のシートではうんともすんとも言わないのです。。。うううぅぅぅ
>>ちなみに、結合と入力規則の解除は、
記録マクロを使うといいというのは、例えば、結合を解除する作業をマクロ記録することで、 .MergeCells = False というコードを見つけることが出来るんですね。 同様に、入力規則の解除は下記のようになりました。
Sub Macro2()
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End Sub
となります。。。力不足ですみません。 ご参考になったかしら(T_T) (代奈)
代奈さん、何度もありがとうございます。力不足なんてとんでも無いです！！ すごく助かっていますよ。(*^^*) ただ、セルの数字を削除したらという条件の立て方がわかりません・・・。 試しに、入力の逆ということで、上記のプログラムの条件の所のNOTを消して If r.Value = "" Then '←数字が無くなった時 というので上のプログラムを当てはめてみたのですが、エラーは出ないのですが 何も動作しません。。。どんな式を作ればいいんでしょうか・・・。 （miu)
記録オンパレード(笑) こうなりました(^^)
Sub Macro1()
Range("C3:C5").Select
Selection.ClearContents
End Sub
選んで、くりあこんてんつ、みたいです（*^◇^*） miuさん、あとすこしで完成かも。。。ですね♪
あ、確か省略できるよね、これって(ーー;)
Range("C3:C5").ClearContents
えっと、セル範囲は変更して下さい。。。
(代奈)
度々、 すみません。。プログラムのどこに組み込むかわかりません・・・。（；＿；） ここにいれればいいのかなと、試しにいれてみたのですがやっぱり動作しません・・・。 下記に、現在のプログラム書きますね。
Private Sub Worksheet_Change2(ByVal Target As Range) Dim r As Range Dim S As Integer
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
For Each r In Target
If r.Value = .ClearContents Then '←数字が無い時
'処理
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
.MergeCells = False
.Font.Size = 11 '---フォント11にする
.Value = ""
.Font.Bold = False '---太字にしない
.ShrinkToFit = False '---縮小表示にしない
End With
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14)).Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End If
Next r
End Sub
（miu)
>If r.Value = "" Then '←数字が無くなった時 >何も動作しません。。。どんな式を作ればいいんでしょうか・・・。 期待通りに動かない場合には、まず r.Valueには何が入っているのか を確かめてみると良いかも。 確かめ方は、 >If r.Value = "" Then '←数字が無くなった時 にカーソルがある状態でF9を押すと、その行が茶色く反転される。 これをブレークポイントと言う。 その後マクロを実行すると、そのブレークポイントに差し掛かった所でコードが止まる。
ここで、r.Valueにマウスカーソルを合わせると、その内容がひょろりと画面に表示される。
あるいは、Ctrl+Gとすると、「イミデイトウィンドウ」なる物が画面下部あたりに表示されるので、 そこに ?r.Value と入力し、Enter。するとr.Valueの内容がその直下の行に表示される。
もしくはrという文字をマウスで選んで右クリックすると、右クリックメニューの中に ウォッチ式の追加…と言うのがあるので選択。 ダイアログが表示されるのでOKとすると、「ウォッチ」なる物が画面に表示される。 これはその中身はなんじゃろね、って言うのをサックリと表示してくれる。
ブレークポイントの解除は同じ行で再度F9。 止まったコードの再開はF5。 止まったコードを1行ずつ実行してみたい時はF8。
これらにより、r.Valueには何が入っているのかが解ったなら、 あとはそれをどうしたいのか、をコードとして書く書く書く。
以上、デバッグの仕方でした。
（ご近所PG）どんな事をやりたいのかまでは把握してません（え？）
衝突追記。相変わらずやりたい事は把握してないけど、
'←数字が無い時
というコメントを頼りに考えると、
If Not IsNumeric(r.Value) Then '←数字が無い時
では駄目ですか？「数字が無い時」というよりは「数値では無い時」という意味になりますが。
デバックの仕方はこれから試してみたいと思います。 ありがとうございます。
やりたいことは数字が入ってるセルA13の数字を消すと C13〜N13が結合と入力規則が設定されているので、それを解除するようにしたいのです。 それが、A13〜A21まであります。 IsNumeric(r.Value)で試してみたのですが、動作しませんでした・・・。 （miu)
（ご近所PG）さん、有難うございます。 私のシートはmiuさんのシートと同じではないと思いますが、最初に提示されたとおりに 簡単なシートを作り、miuさんのコードをはりつけ、テストしてみましたが。。。 「r」範囲を消してもマクロは動かず、確認してもイミディエイトでもウォッチでも「Empty」となります。 根本的に、どうなんでしょうか。 私の捉え方が間違っているのでしょうか。 こちらでは１つ目のマクロも２つ目のマクロも、うんともすんとも言わないのですが。。。
なんか。。。 一見すると簡単な命令だけのような気がするのに。。。ため息出てきます。 miuさんご希望の書式にするのに、例えばマクロの記録をしたとして、 あとはそれにただ 条件文だけ追加するだけなのに。。。 (悲しい代奈)
ちょっと忙しくて詳しく見てないですが Worksheet_Change2 ってイベントは無いのです。その辺は大丈夫ですか？ （ご近所PG）
miuさん! あのね、もしかして標準モジュールに書き込んでる？ Module1 とかって書いてあるところの右側の白い場所じゃなくって、 ThisWorkbook って書いてあるところの右側の白いところに、以下を貼り付けてみて。 私のではうまく動いたよ！ (代奈)
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range Dim S As Integer
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
For Each r In Target
If r.Value = "" Then '←数字が無い時
'処理
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
.MergeCells = False
.Font.Size = 11 '---フォント11にする
.Value = ""
.Font.Bold = False '---太字にしない
.ShrinkToFit = False '---縮小表示にしない
End With
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14)).Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End If
Next r
End Sub
代奈さん宛 >ThisWorkbook って書いてあるところの右側の白いところに、以下を貼り付けてみて。 と言うよりはですね、Sheetの白いところにですね、 「Worksheet_Change2」ってのを「Worksheet_Change」とした物を貼り付けると動くはずです。 miuさんは多分そこにWorksheet_Change2として書いてるので動かないのだと思います。 多分。多分。 Sheetのイベントは、その白い所の上に(General)とか(Declarations)とかある所を マウスでポチポチ押すとなんか解るかも。 （ご近所PG）
ほんとだ。。。(ーー;) でも何で標準モジュールではダメなんですか？ (代奈)
感激です！ありがとうございます！ 最初、Worksheet_Changeで作ったらエラーが出たので、結合と入力規則を設定する プログラムと同じ名前だからエラーが出たのかと思い、とっさに２を付けてました。 お二人のアドバイスから、二つのプログラムを一つにしたらと思い、直してみたら 見事にきちんと動作しました。 すごく助かりました。ありがとうございました。
p.s.
贅沢言うと、保護の件も出来ると完璧なのですが、手動の時点でエラーが出るということは プログラムでやってもエラーが出てやっぱり無理な気がしてきました・・・。（；；）
Private Sub WorkSheet_Change(ByVal Target As Range) Dim r As Range Dim S As Integer
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
For Each r In Target
If Not r.Value = "" Then '←数字が入力された時
'処理
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
.Merge
.Font.Size = 20 '---フォント20にする
.Value = ""
.Font.Bold = True '---太字にする
.ShrinkToFit = True '---縮小表示にする
End With
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14)).Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=$y:$y"
End With
End If
Next r
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
For Each r In Target
If r.Value = "" Then '←数字が無い時
'処理
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
.MergeCells = False
.Font.Size = 11 '---フォント11にする
.Value = ""
.Font.Bold = False '---太字にしない
.ShrinkToFit = False '---縮小表示にしない
End With
With Range(Cells(Target.Row, 3), Cells(Target.Row, 14)).Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End If
Next r
End Sub
(miu)
ほんとだほんとだ！ やったねー！（*^◇^*)／ すごいすご〜い！ miuさん、はい。お疲れさま( ^^) _旦~~ ご近所PGさん、御指導ありがとうございました！ (代奈)
って。。。喜んでる間に一難さってまた一難？ ふぁいとっ(>_<) (代奈)
ちょっと気になったんだけど、解除のほうのマクロ、 13行しか解除されないみたいなんだけど、miuさんのは14行以降も解除される？ (代奈)
説明が大変そうなので検索してみました。 Let's Excel VBA 8. モジュールとイベントについて http://www.sanynet.ne.jp/~awa/excelvba/kouza/chapt_01/sec08_01.html
>贅沢言うと、保護の件も出来ると完璧なのですが、手動の時点でエラーが出るということは
そうですねぇ、手作業でエラーが出るなら出来ないんじゃないですかねぇ。
保護云々っていうのに詳しくないので解らないけど。
少しだけ、見やすくまとめてみます。
Private Sub WorkSheet_Change(ByVal Target As Range)
Dim r As Range
'対象外は抜ける？
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
For Each r In Target '変更されたセル全てに対して処理
If r.Value = "" Then '空欄の時
'With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.MergeCells = False
.Font.Size = 11 '---フォント11にする
.Value = ""
.Font.Bold = False '---太字にしない
.ShrinkToFit = False '---縮小表示にしない
With .Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End With
Else '空欄では無い時
'With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.Merge
.Font.Size = 20 '---フォント20にする
.Value = ""
.Font.Bold = True '---太字にする
.ShrinkToFit = True '---縮小表示にする
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=$y:$y"
End With
End With
End If
Next r
End Sub
（ご近所PG）
やはりA14〜解除されないね。。。 (代奈)
ご近所PGさん、簡略化使わせてもらいます！ありがとうございます。 こっちの方が見やすくて良いですね。
代奈さん、そうなんです。一難さってまた一難・・・。（苦笑） miu！贅沢ばかり言うな！って感じですね。。。（冷汗） あれ？でも、A１４〜は私のだと解除はきちんと出来ちゃいます？？？ なんでだろう？？？ (miu)
あぁ、はい、なるほど。変更しました。
'With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
この辺り。
（ご近所PG）
有難うございますm(__)m
ワークブックモジュール ブック全体のイベントに対して実行したいコードを記述します。 プロジェクトのウィンドウで表示されている「ThisWorkbook」です。
標準モジュール
自動マクロやメインコードを記述します
フォームモジュール
独自のフォームを作成するときに使用
クラスモジュール
新しいオブジェクトを作成するときに使用 （バリバリのプログラマーが使います？）
つまり、イベントにしたいときは、標準モジュールではダメってことなのですね？
※ 変更ありがとうございました。ばっちりです！ (代奈)
あ、今までのだと複数選んで消す時一番上しか解除されなかったんですけど 変更したらきちんと動作しました！！！ ご近所PGさんありがとうございます。
代奈さん、長々と、お付き合いしてくれて本当にありがとうございました。(*^^*) 保護の件はあきらめるとして（＾＾；）、今回のプログラムでかなり作業が楽になるので本当に助かりました。ありがとうございます。
（miu）
>保護の件はあきらめるとして 何が問題なのでしょう？ (INA)
手動で保護にしようとしてもダメだったみたいですよ？ miuさん、ダメだった手順を詳しく書いてみては如何でしょう(^^) (代奈)
INAさん、なんとかプログラムは皆さんに助けて頂き、きちんと動作するようになりました。 ただ、今回数字を「入力するセル」と「結合等するセル」以外は全てシート保護（計算式とか入ってるので。。。）したいんですが 保護の状態で作業するとエラーが実行時エラー１００４、アプリケーション定義、またはオブジェクトエラーというのが出てしまうんです。
今日は、もう帰り支度になってしまうので、また明日来ます！お返事遅くなってしまったら、ごめんなさい。m(__)m （miu）
うーん。 確かに、シートを保護してしまうと入力できず実行時エラー'1004' 保護されたシートに対してこのコマンドは使用できません。 というアラートが。。。 かといってシート保護解除するとセルロックできない。。。 どうしたらいいんでしょうね。 (代奈)
おぉ。 つまりA13〜A35のセルのみ入力可で、他セルにはダイレクト入力不可のコードを探せばいいんだ。 (代奈)
あらかじめ、入力するセルだけロックを解除しておき、シートを保護する。 そしてマクロの中で、保護解除→処理→再度保護 とすれば出来ませんか？
(INA)
大いなるヒント有難うございます(^^) 明日、やってみます。 (代奈)
急なトラブルで返事が遅くなりましたが >つまり、イベントにしたいときは、標準モジュールではダメってことなのですね？ そんな感じです。 （ご近所PG）そんだけかい まぁ、シートのイベントとして認識させるならシートん中にかいてね、と。
おはようございます。 早速、保護解除→処理→再度保護で作成してみました！ ただ、処理が終わった後にシートを全選択の状態で終わってしますのですが どこがいけないか教えてください。。。
Private Sub WorkSheet_Change(ByVal Target As Range)
Dim r As Range
'対象外は抜ける？
ActiveSheet.Unprotect '保護解除
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
For Each r In Target '変更されたセル全てに対して処理
If r.Value = "" Then '空欄の時
'With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.MergeCells = False
.Font.Size = 11 '---フォント11にする
.Value = ""
.Font.Bold = False '---太字にしない
.ShrinkToFit = False '---縮小表示にしない
With .Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End With
Else '空欄では無い時
'With Range(Cells(Target.Row, 3), Cells(Target.Row, 14))
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.Merge
.Font.Size = 20 '---フォント20にする
.Value = ""
.Font.Bold = True '---太字にする
.ShrinkToFit = True '---縮小表示にする
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=$y:$y"
End With
End With
End If
Next r
'数式の入ってるセルの保護
ActiveSheet.Select
Cells.Select
With Selection
.Locked = False
.SpecialCells(xlCellTypeFormulas).Locked = True
End With
ActiveSheet.Protect
End Sub
（miu）
出来ちゃいました！！ AのセルからCのセルに移動して、入力規則のリストを選択できたらと思い、 カーソルの移動を付け加えてみました。 ようやく、完成できました。皆様、本当にありがとうございました。 以下、完成したプログラムです。 (miu)
Private Sub WorkSheet_Change(ByVal Target As Range)
Dim r As Range
Dim a As Long
Dim b As Long
'対象外は抜ける？
ActiveSheet.Unprotect '保護解除
'現在のセルのアドレス取得
a = ActiveCell.Row
b = ActiveCell.Column
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
For Each r In Target '変更されたセル全てに対して処理
If r.Value = "" Then '空欄の時
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.MergeCells = False
.Font.Size = 11 '---フォント11にする
.Value = ""
.Font.Bold = False '---太字にしない
.ShrinkToFit = False '---縮小表示にしない
With .Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End With
Else '空欄では無い時
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.Merge
.Font.Size = 20 '---フォント20にする
.Value = ""
.Font.Bold = True '---太字にする
.ShrinkToFit = True '---縮小表示にする
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=$y:$y"
End With
End With
End If
Next r
'数式の入ってるセルの保護
ActiveSheet.Select
Cells.Select
With Selection
.Locked = False
.SpecialCells(xlCellTypeFormulas).Locked = True
End With
'セルの移動
Cells(a, b + 1).Select
ActiveSheet.Protect
End Sub
おお！出来たのですね！ 今、出先から帰って覗いてみたら。。。 よかったよかった（*^◇^*） (代奈)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.