エクセルでリストから特定のデータを選択した場合に、隣接するセルで入力待ちにするには？

Question

エクセルで、上下に隣接するセルで、上のセルでリストから「出張」又は「研修」を選択した場合に、下のセルで入力待ちにして、リストから行先を選択させるマクロを組みたいのですが、上手くできません。

本コーナーやスマホのQ&Aなどを参考にして、下記のように記述したのですが、”入力待ち”状態になりません。どなたか、ご教示頂けると助かります。

　　　　　　記

Option Explicit

Public Wait As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)

  If Not Intersect(Target, Range("F7:BP7,F9:BP9")) Is Nothing Then

    If Target.Value = "研修" Or Target.Value = "出張" Then

      MsgBox "（出張先、研修会場）を、下のセルに入力して下さい。", vbOKOnly

'ひとつ下のセルに移動する

      Dim rng As Range

      Set rng = ActiveCell

      rng.Offset(1, 0).Select

'入力待ち

      Wait = True

      Do Until Wait = False

      DoEvents

      Loop

      If Not Intersect(Target, ActiveCell) Is Nothing Then

      Wait = False

      End If

    End If

  End If

End Sub

Answer 1

こんにちは。

お書きになられているコードの最大の問題点は下記の 4行にあるかと思います。

Wait = True

Do Until Wait = False

  DoEvents

Loop

『 Until Wait = False 』は『 While Wait = True 』と等価です。

つまり、このループは Wait が True である限り抜け出せない永久ループになります。

DoEvents があるので他のイベントは受け付けますが、その処理が終われば再びこのループに戻ります。

例えば、この Worksheet_Change イベントも再び実行され更にループに入る可能性もあり、その場合は多重の永久ループに入ってしまいます。

他のイベントなどで Wait を False にすれば永久ループから抜け出せますが、提示されているコードを見渡してみても、そういった処理は行なわれていないように思えます。

それと、入力を待機させたいのではなく「入力セルを限定させたい」というご希望なのかなと推測しているのですが、その場合、肝心の入力セルを限定させる（セルの移動の制限をする）ためのコードが抜けてしまっています。

以下は、F7:BP7 もしくは F9:BP9 のセル範囲にあるリストから「研修」または「出張」を選択した場合に、該当セルの直下のセルからセルの移動が出来ないようにする（正確にはセルが移動した後に元に引き戻す）ためのコードです。

※該当セルの直下のセルへの入力が完了すれば、他のセルに自由に移動できるようになります。

尚、Worksheet_Change イベントと Worksheet_SelectionChange イベントの 2つのイベントを連携させていますので、どちらかのイベントを強制停止させたりしないようにご注意ください。

また、2つの変数をイベント外にモジュール変数として記述していますので、全てをコーディング（またはコピー・貼り付け）し終わってから起動させるようにしてください。

Dim rng As Range

Dim flag As Byte

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

  Application.EnableEvents = False

  flag = 0

  If Not Intersect(Target, Range("F7:BP7,F9:BP9")) Is Nothing Then

    If Target.Value = "研修" Or Target.Value = "出張" Then

      MsgBox "（出張先、研修会場）を、下のセルに入力して下さい。", vbOKOnly

      flag = 1

      Set rng = Target.Offset(1, 0)

      rng.Select

    End If

  End If

  Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  Application.EnableEvents = False

  If flag = 1 Then

    If Target.Address <> rng.Address Then

      rng.Select

    End If

  End If

  Application.EnableEvents = True

End Sub

本来、WindowsAPI などを使ってセルの移動制限などをすべきなのかもしれませんが（これについては門外漢なので）、動きは少しトリッキーになっても VBA だけで行う方法を考えてみました。

これは一例に過ぎませんが、よろしければお試しになってみてください。

以上です。

Windows10 と Excel2016 の組み合わせで動作確認しています。

ご参考になれば幸いです。

Answer 2

ひまじん先生へ

誤りをご指摘、訂正して頂きありがとうございます。また、私のやりたかった事（セルの移動制限）まで教えていただきありがとうございます。

快適に動作しました。

とても感謝しています。