エクセルでの連番の処理

質問

お世話になります。
１行目に入力されたデータをルールに沿って２行目以下にどんどん追加していきたいと思っています。
まずD1、E1のセルに数字を入れます。
例：D1に3、E1に25　を入れてマクロを実行するとD列の2行目以下に3,4,5,6…25と連番で入力出来るようにしたいのです。
この例ではD列は24行目まで入力されています。そこで2行目から24行目までのＡ，Ｂ，Ｃ列にはそれぞれ１行目のＡ，Ｂ，Ｃ列と同じデータを入力します。なおＡ，Ｂ，Ｃ列は数字、文字列どちらもあります。空白の場合もあります。
この状態でＡ～Ｅ列の１行目のデータを変更し、仮にD1を2、E1を15としたとします。ここで再度マクロを実行すればD25に2、そして順に連番が入りD38に15が入るようにします。
同時に２５行目から３８行目までのＡ，Ｂ，Ｃ列にはそれぞれ１行目のＡ，Ｂ，Ｃ列と同じデータを入力します。
これの繰り返しです。
つまり２行目以下のＤ列で空白の行以下にどんどん連番を入れていく具合です。
前提としてD1、E1は整数しか入りません。またE1の数字はD1より大きいです。ただD1,E1に同じ数字が入った場合、その数字の１行分だけが入力されるようにします。
以上の処理が自動化できるマクロはできますか？
アドバイス願います。

回答No.2

Wendy02 · ベストアンサー

こんばんは。Wendy02です。

>今のままではE1が変わるたびに動くようですので。
単に入れ替えればよいだけです。

なお、コントロールツールのボタンにしてくださいね。フォームですと、ちょっと書き方が変わります。

それと、前回の分(2440028)は、まだオープンのままですから、問題がないようでしたら、、締めてくださいね。

'シートモジュール
'---------------------------------------------------------
Private Sub CommandButton1_Click()
Dim i As Long
　Dim j As Long
　Dim rw As Long
　rw = Range("D65536").End(xlUp).Row
　If IsNumeric(Range("D1").Value) And IsNumeric(Range("E1").Value) Then
　　i = Range("D1").Value: j = Range("E1").Value
　　If j >= i Then
　　　If rw + (j - i) + 1 > 65536 Then MsgBox "行のオーバーになります。", vbCritical: Exit Sub
　　　Cells(rw + 1, 4).Resize(j - i + 1).FormulaLocal = "=" & CStr(i) & "+Row(A1)-1"
　　　Cells(rw + 1, 4).Resize(j - i + 1).Value = Cells(rw + 1, 4).Resize(j - i + 1).Value
　　　Range("A1:C1").Offset(rw).Resize(j - i + 1, 3).Value = Range("A1:C1").Value
　　End If
　End If
End Sub

お礼

前回ともどもお世話になりました。
今まで手動でしていた作業時間とくらべてはるかに効率的になりました。ありがとうございました。

回答No.1

Wendy02

こんばんは。Wendy02です。

以下のようにはなりますが、私自身としては、実用化させるには、もう一工夫が必要な気がします。例えば、ツールバー式に、窓を作るとか、ダイアログボックスを作ってあげるとか。

'シートモジュールに貼り付けてください。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim i As Long
　Dim j As Long
　Dim rw As Long

　If Target.Count > 1 Then Exit Sub
　If Target.Address <> "$E$1" Then Exit Sub　'E1 をターゲットキーとする
　rw = Range("D65536").End(xlUp).Row

　If IsNumeric(Range("D1").Value) And IsNumeric(Range("E1").Value) Then
　　i = Range("D1").Value: j = Range("E1").Value
　　If j >= i Then
　　　If rw + (j - i) + 1 > 65536 Then MsgBox "行のオーバーになります。", vbCritical: Exit Sub
　　　Application.EnableEvents = False
　　　Cells(rw + 1, 4).Resize(j - i + 1).FormulaLocal = "=" & CStr(i) & "+Row(A1)-1"
　　　Cells(rw + 1, 4).Resize(j - i + 1).Value = Cells(rw + 1, 4).Resize(j - i + 1).Value
　　　Range("A1:C1").Offset(rw).Resize(j - i + 1, 3).Value = Range("A1:C1").Value
　　　Application.EnableEvents = True
　　End If
　End If
End Sub

補足

ご回答ありがとうございます。
こちらの期待通りの動きをしてくれました。
ただご指摘のとおり実用的にするにはボタンをクリックするたびに動作させるようにしたいです。今のままではE1が変わるたびに動くようですので。アドバイスお願いします。