ExcelのVBAでループ部分が上手く行かないのでご教授ください。

Question

エクセルで画像の様な表を作っています。

B13→B14→B15→C13→C14→C15→D13・・・
とインプットボックスを使って入力していきたいと思い、

Sub データ入力()
Dim kataban As String

'データ入力範囲を認識し、終端セルを選択する

If Range("B13").Value = "" Then
Range("B13").Select
Else
Range("B12").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If

'データを入力するダイヤログボックスを表示する
Do While ActiveCell.Offset(0, -1).Value <> ""
   kataban = InputBox("大問NO.を入力します" & Chr(10) & _
   "終了する場合はendを入力してください", "大問")
   If kataban = "end" Then
      Exit Do
   Else
      ActiveCell.Value = kataban
      ActiveCell.Offset(0, 1).Select
      ActiveCell.Value = InputBox("領域名を入力します", "領域名")
      ActiveCell.Offset(0, 1).Select
      ActiveCell.Value = InputBox("得点数を入力します", "得点")
      ActiveCell.Offset(1, -2).Select
   End If
Loop

End Sub

の様なマクロを作成したのですがループの部分が上手く行きません。

どなたかわかる方がいましたら、ご教授の程よろしくお願い致します。

Comments

[Orlofsky]

コードは https://teratail.com/help/question-tips#questionTips3-7 の [コード] に修正してください。

[Orlofsky]

教授 → 教示

[imihito]

> ループの部分が上手く行きません。
どのように上手く行かないのですか？
「○○のように動作して欲しいが、××となってしまう」のように目的の動きと現状の動きを、質問に追記してください。

e.g. 左隣の列(A列)に「国語」と入っている範囲(13行目から17行目まで）をDo...Loopでループして欲しいが、13行目の入力まででループが止まってしまい、14行目以降に進まない。

Answer 1

B13→B14→B15→C13→C14→C15→D13・・・
とインプットボックスを使って入力していきたいと思い、

んと。
入力したいセル範囲選択→セルの書式設定→保護
と選んで、
ロックのチェックを外しOK

リボンの校閲タブ→シートの保護で、
ロックされてないセルの選択以外のチェックを外してOK
で、
期待した動きになるかと思いますが、
インプットボックスが必須ですかね？
複数セルを編集出来るのがエクセルの強みなのに、
それを捨ててまで制御するほどの業務とは思えませんが。。。
なぜ、インプットボックスなのでしょう？

---

一応、コード書いてみました。
Activecellとかはできれば使いたくないです。
状況に依存するので。。

Sub test001()
    Dim rngInput As Range
    Dim c As Range
    Dim sProm As String
    Dim sValue As String
    Const cProm As String = _
          "を入力してください。" & vbLf & "(キャンセルで終了)"

    Set rngInput = Range("B13:D17")
    For Each c In rngInput.Cells
        c.Select
        sProm = Intersect(c.EntireColumn, rngInput.Rows(0)).Value
        sValue = InputBox(sProm & cProm, sProm, c.Value)
        If StrPtr(sValue) = 0 Then Exit For
        c.Value = sValue
    Next
End Sub

操作したい範囲に対して繰り返し処理をするように書きます。