『よっし〜さんの下記相談をvbaで・・・』（トラサン） [[20061119105819]]　『セルの条件付き入力規則について』（よっし〜）　>>BOT 『セルの条件付き入力規則について』（よっし〜） [エクセルのバージョン]Excel2003　[OSのバージョン]WindowsXP 教えてください。 セルA1に値(文字列)が入力してあると、セルB1に値の入力が可能となり、 セルA1がブランクなら、セルB1には値の入力ができない。 また、セルA1の値をデリートして空白にすると、セルB1も空白になる。 ↑みたいにしたいのですが、入力規則でできるのか、マクロを組まないとだめなのかよく分かりません。 よろしくお願いします。 ⇒全く同じことをＶＢＡで行いたいです。 ご教授を宜しくお願いします。 EXCEL2003 windouws xp ---- マクロでなく入力規則で。 B1で入力規則 「ユーザー設定」 数式 =A1<>"" 空白セル無視チェックをはずす。 ※コピペ可能なので万全にするならマクロで。 (GobGob) ---- GobGob様 ありがとうございます。 教えていただいた方法で、 「セルA1に値(文字列)が入力してあると、セルB1に値の入力が可能となり、 セルA1がブランクなら、セル　　B1 には値の入力ができない。」 ・・・は出来ましたが、 後半の「また、セルA1の値をデリートして空白にすると、セルB1も空白にな る。 」 が出来ません。 出来れば、両方をマクロ（vba）で行いたいのですが・・・　 （トラサン） ---- Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Target, Me.Range("A1:B1")) Is Nothing Then If IsEmpty(Me.Range("A1").Value) Then Application.EnableEvents = False Me.Range("B1").ClearContents Application.EnableEvents = True End If End If End Sub こんな感じで良いのではないでしょうか （ｍｏｍｏ） ---- ｍｏｍｏ様 ありがとうございます。 いただいたコードでやはり前半の 「セルA1に値(文字列)が入力してあると、セルB1に値の入力が可能となり、 セルA1がブ ランクなら、セル　　B1 には値の入力ができない。」はできましたが、 後半の「また、入力済みのセルA1の値をデリートして空白にすると、セルB1も空白にな る」ですが、 入力済みのA1セルの内容を消しても、Ｂ1の値は消えません。 （トラサン） ---- >入力済みのA1セルの内容を消しても、Ｂ1の値は消えません。 ん？　そんな事は無いと思いますが・・・ コードは調べてもらえばわかると思いますが 「Ａ１かＢ１セルに変更があった場合にＡ１が空白ならＢ１を消す」 という事をしているだけなのでＡ１が空白になればＢ１は消えるはずです。 コードは該当シートのモジュールに記載していますか？ （ｍｏｍｏ） ---- A1はきちんと空欄になっていますか。 スペース(空白文字)が入力されていたらダメですよ。 (あん) ---- ありがとうございます。 A1はきちんと空欄になっていますか。 ⇒空欄にしましたが、ダメでした。 コードは該当シートのモジュールに記載していますか？ ⇒該当シートのモジュールに記載したところ、 コンパイルエラー＝名前が適切ではありません：Worksheet_Changeと出てしまいました。 ちなみに、最終的にブック内に5枚のシートがあり、その全てのシートの1000行目まで同様の処理を行いたいのですが、 どのような方法があるでしょうか？ (トラサン) ---- >コンパイルエラー＝名前が適切ではありません：Worksheet_Changeと出てしまいました。 Changeイベントプロシージャがもう１つありませんか？ 最終的な事はおいておいて、まずは動作を確認してください。 >空欄にしましたが、ダメでした。 ダメとはどのような状況でしょうか？ ・モジュールにコードが書かれているシートで実行しているか ・プロシージャは起動しているか ・Application.EnableEventsがTrueになっているか ・TargetのAddressがA1またはB1か ・IsEmpty([A1].Value)はTrueか など確認してみましょう。 （ｍｏｍｏ） ---- ｍｏｍｏ様 シートのモジュールには、既に下記のような 別マクロのコードを記載してます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myRng As Range Set myRng = Range("A:B") With Target If Intersect(.Cells, myRng) Is Nothing Then Exit Sub If Intersect(.Cells, myRng.Columns(myRng.Columns.Count)) Is Nothing Then Cells(.Row, .Column + 1).Select Else Cells(.Row + 1, myRng.Columns(1).Column).Select End If End With End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If (Application.CutCopyMode <> False) Then Application.CutCopyMode = False End If End Sub 標準モジュールには、 Sub auto_open() Application.CellDragAndDrop = False End Sub Sub auto_close() Application.CellDragAndDrop = True End Sub というコードを書いています。 ・Application.EnableEventsがTrueになっているか ・IsEmpty([A1].Value)はTrueか については、良く理解できていません。 >空欄にしましたが、ダメでした。 ダメとはどのような状況でしょうか？ ⇒A1の内容を空白にしても、Ｂ1の内容が同じように消えなかったという意味です。 （トラサン） ---- Changeイベントを以下のように変更してみてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Me.Columns("A"), Target) Is Nothing Then Target.Offset(0, 1).Cells(1).Select If IsEmpty(Target.Value) Then Application.EnableEvents = False Target.Offset(0, 1).ClearContents Application.EnableEvents = True End If ElseIf Not Application.Intersect(Me.Columns("B"), Target) Is Nothing Then Target.Offset(1, -1).Cells(1).Select If IsEmpty(Target.Offset(0, -1).Value) Then Application.EnableEvents = False Target.ClearContents Application.EnableEvents = True End If End If End Sub （ｍｏｍｏ） ---- ｍｏｍｏ様 完ぺきにやりたいことが出来ました。 誠にありがとうございます。 （トラサン） ---- 以前、相談させていただいた上記内容ですが、 応用力がないため、別のシートに適応できずに困っています。 別の資料ですが、内容的には、同様のことがやりたいです。 以下は、前回の相談内容です。 「上は、A列とB列の関係ですが、 今回は、A列と「B列からF列」までの関係です。 セルAに値(文字列)が入力してあると、セルB〜F列まで値の入力が可能となり、 セルA1がブランクなら、セルB1には値の入力ができない。 また、セルA1の値をデリートして空白にすると、セルB1も空白になる。 ↑みたいにしたいのですが、入力規則でできるのか、マクロを組まないとだめなのか 　分かりません」 以上、 　そこで 　Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Me.Columns("A"), Target) Is Nothing Then Target.Offset(0, 1).Cells(1).Select If IsEmpty(Target.Value) Then Application.EnableEvents = False Target.Offset(0, 1).ClearContents Application.EnableEvents = True End If ElseIf Not Application.Intersect(Me.Columns("B：F"), Target) Is Nothing Then Target.Offset(1, -1).Cells(1).Select If IsEmpty(Target.Offset(0, -1).Value) Then Application.EnableEvents = False Target.ClearContents Application.EnableEvents = True End If End If End Sub 　の 　ElseIf Not Application.Intersect(Me.Columns("B：F"), Target) Is Nothing Then 　と標準モジュールに記載しましたが、 　何も反応しません。 Thisworkbookには、 Private Sub Workbook_SheetActivate(ByVal Sh As Object) ActiveWindow.Zoom = 120 Application.DisplayFullScreen = True End Sub というコードがあり、これが何か関係しているのでしょうか？ （トラサン） ---- ＞標準モジュールに記載しましたが、　何も反応しません。 Private Sub Worksheet_Changeは標準モジュール登録では意味がありません。 この動作を行いたいシートのシートモジュールに記載してください。 　 ＞これが何か関係しているのでしょうか？ 部分的にしかみていない掲示板の回答を丸写ししているだけでは 将来そのようなことは起きえるでしょう。 動作の検証（デバッグ）をできるようにしておくことを お勧めします。 　 If Not Application.Intersect(Me.Columns("A"), Target) Is Nothing Then 　　　　： End If この部分はA列をClearContentsしたらB列をClearContentsします。 Target.Offset(0, 1).ClearContentsがそういう意味です。 　 ElseIf Not Application.Intersect(Me.Columns("B：F"), Target) Is Nothing Then 　　　　： End If この部分がB:F列に対しての処理だと思われますが、 一つ一つのコードの解釈がまだ不十分だと感じられます。 (みやほりん)(-_∂)b ---- ちょっと仕様がはっきりしないところがあるので、 コードもまとめにくいね。 　 （１） セルAに値(文字列)が入力してあると、セルB〜F列まで値の入力が可能となり、 （２） セルA1がブランクなら、セルB1「だけ」には値の入力ができない。 　　　　　　　　　　　　　　　　　　　↑ 　　　　　　　　　　　　　　　　これでいいのか。C:Fは入力可能でもいいのか。 　　　　　　　　　　　　　　　　だとすると、（１）と矛盾する。 （３）また、セルA1の値をデリートして空白にすると、セルB1「だけ」空白になる。 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　↑ 　　　　　　　　　　　　　　　　　　　　　　　　　これでいいのか。C:Fはそのままでもいいのか。 (みやほりん)(-_∂)b ---- (みやほりん)(-_∂)b様 ありがとうございます。 （１） セルAに値(文字列)が入力してあると、セルB〜F列まで値の入力が可能となり、 （２） セルA1がブランクなら、セルB1「だけ」には値の入力ができない。 　　　　　　　　　　　　　　　　　　　↑ 　　　　　　　　　　　　　　　　これでいいのか。C:Fは入力可能でもいいのか。 　　　　　　　　　　　　　　　　だとすると、（１）と矛盾する。 （３）また、セルA1の値をデリートして空白にすると、セルB1「だけ」空白になる。 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　↑ 　　　　　　　　　　　　　　　　　　　　　　　　　これでいいのか。 C:Fはそのまま でもいいのか。 （２）ですが、B1からF1まで入力ができないことにしたいです。 （３）もB列からF列までを空白にしたいです。 表記がややこしく、申し訳ありません。 （トラサン） ---- 自分好みの構文で申し訳ないけど、 こんな感じでしょうか。処理を行いたいシートのモジュールへ記載してください。 　 Private Sub Worksheet_Change(ByVal Target As Range) Dim myC As Range Set myC = Application.Intersect(Me.Columns("A:F"), Target) If myC Is Nothing Then Rem 何もしない Else Application.EnableEvents = False Select Case Target.Cells(1).Column Case Is = 1 If IsEmpty(Target.Value) Then Target.Offset(0, 1).Resize(1, 5).ClearContents End If Case 2 To 6 If IsEmpty(Target.EntireRow.Cells(1).Value) Then Target.EntireRow.Range(Cells(2), Cells(6)).ClearContents End If Case Else End Select Application.EnableEvents = True End If Set myC = Nothing End Sub 　 (みやほりん)(-_∂)b ---- 何べんも更新申し訳ない。 もしかしたら、下記でいいかもしれません。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myC As Range Set myC = Application.Intersect(Me.Columns("A:F"), Target) If myC Is Nothing Then Rem 何もしない Else Application.EnableEvents = False If IsEmpty(Target.EntireRow.Cells(1).Value) Then Target.EntireRow.Range(Cells(2), Cells(6)).ClearContents End If Application.EnableEvents = True End If Set myC = Nothing End Sub (みやほりん)(-_∂)b ---- 本当に何度も更新して申し訳ない。 セル選択の挙動を完全に忘れてました。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myC As Range Set myC = Application.Intersect(Me.Columns("A:F"), Target) If myC Is Nothing Then Rem 何もしない Else Application.EnableEvents = False If IsEmpty(Target.EntireRow.Cells(1).Value) Then Target.EntireRow.Range(Cells(2), Cells(6)).ClearContents End If Application.EnableEvents = True Select Case Target.Cells(1).Column Case 1 To 5 Target.Offset(0, 1).Cells(1).Select Case 6 Target.Offset(1, 0).EntireRow.Cells(1).Select Case Else End Select End If Set myC = Nothing End Sub 　 (みやほりん)(-_∂)b ---- (みやほりん)(-_∂)b様 勉強になります。 前回分と比較して、研究してみます。 ありがとうございました。 （トラサン） ---- すみません。 お手数ですが、もう一つ、質問させてください。 実は、この表は、データフォームを使っています。 A列は、リストから入力制限をかけているのですが、 「リスト外のデータ」を打ち込むとキャンセルをするしかなくなります。 その際にB列からF列に先にデータを打ち込んでいると、データフォームを 閉じたときにBからF列だけ残ってしまいます。 （A列を消した効果がB〜F列に反映されません） この場合は、どのように解決したらよいのでしょうか？ ご教授をよろしくお願いいたします。 （トラサン） ---- データメニューの「フォーム」コマンドを使っているということでしょうか。 入力後のセル移動をコードに取り入れていたので、これは想定外。 　 このコマンドが実行されている間、つまり、フォームが表示されている間は 他の組み込みダイアログボックスと同様、「ユーザーの作ったマクロ」は 働かないので、A列のデータがフォームでクリアされても利きません。 　 試しに、コードの適当な位置でブレークポイントを設定しても、 フォームでのデータ入力中にはブレーク（コードの一時停止）が発生しません。 マクロそのものが実行されないので、当たり前ですが。 これに対して、入力規則は組み込みの機能なので、働きます。 正規の機能の前には後付けのマクロは蹴散らされてしまうわけです。 　 組み込みのデータフォームを使う限り、マクロでは制御が不可能です。 すでに提案したマクロでの解決方法はありません。 　 したがって、解決策を求めるというよりは、方針の転換を迫られます。 　 現状の何かを諦めるか、 あるいは、フォームの代替になり、かつ、思い通りになるユーザーフォームを 自作するか、ですね。 　 ただ、組み込みの機能であるフォームを完全にシミュレートできるような ユーザーフォームの作成は、かなり大変じゃないでしょうか。 ですから、そういうのを作ってくれ、という依頼がきたら、 「お金かかってもいいなら、プロに頼んでちょうだい」って答えちゃうな。 「一時間程度の頭の体操サンプルマクロ」では済まなく成っちゃうから。 　 無限に時間を提供できるわけじゃないので、そこらへんは赦してください。 　 ということで、参考ページだけ紹介してみます。 [三流君VBA：Excel UserForm で データ・フォームの機能を真似てみる] http://www.ken3.org/vba/backno/vba063.html 　 ↑ これを使ってみなさい、という意味ではないです。 私はダウンロードしていませんから、まったく確認していません。 このページに書いてあることが、なんとなくでも分かるレベルなら、 ファイルを参考にして、自作に挑戦してみても良いかもしれませんね。 　 （みやほりん） ---- みやほりん様 ご教授ありがとうございます。 たとえば、ブックを閉じるときにすべてのシートのA列をコピーし、同じところでペース トするような マクロにすることで、このようなごみを消せると思うのですが、 やり方（VBAの書き方）がわかりません。 ご教授いただけたら幸いです。 (トラサン) ---- >ブックを閉じるときにすべてのシートのA列をコピーし、同じところでペース トするような ペーストすることでWorkSheet_Cangeイベントを発生させるということですか？ 列単位で処理したいということなら、WorkSheet_Cangeイベントもそれなりの 仕様にしないといけませんね。 　 むしろ、ブックを閉じるときにWorkSheet_Cangeイベントとは別に一括処理、 としたほうが良いかもしれません。 　 後でまとめて消えるだけでもいいや、ということなら、 WorkSheet_Cangeイベントはそれほど必要は無い、ということに なります。 　 部分的にできる、できないという議論を繰り返しても手直しが多くなるだけなので 全体の処理の流れをもう少し練る必要がありませんか？ 　 みやほりん ---- ミヤホリン様 ありがとうございます。 遅くなり、申し訳ありません。 下記、ご相談ポイントがずれていたらすみません。 ・別シートをアクテイブにするときに上記を実行するのが、 一番いいと思うのですが、如何でしょうか？ （トラサン） ---- 上記、とはどの処理のことですか？ シートをアクティブにしたときに実行、といいますが、 今までの流れで、入力規則のリストを使い、制限値を設けていたり、 フォームで入力したり、 また、チェンジイベントでセルの制御をしていたりといろいろな仕様が 錯綜しているので、私にはどの機能を重視して、どの機能を切り捨てるのか、 また、どのような入力をしていくのか、どうやって手をつけてよいのか、 判断しかねる状況です。 　 入力の段階ではフォームを使いたいのですか？ （みやほりん）