エクセルで行挿入＆コピー

質問

エクセルにて下記のように入力してあります。

A 　　　 B 　　　C 　　　 D
111 　　111
222 　　111

次にＣ列の一行目にＭ001、Ｄ列の一行目にA00１を入力した後（セルは２行目）に任意の行数を挿入し、さらにＡ，Ｂ列は一行目をコピー、Ｃ，Ｄ列は連番になるようにＶＢで作成するにはどうしたらいいでしょうか。
よろしくお願い致します。

回答No.4

matsu_jun · ベストアンサー

A～F列を直上の値のコピー、G、H列を連番にすると以下のようになります。
貼り直してください。
なお、挿入したくない場合は、InputBoxが表示された時点でキャンセルをクリックするか
キーボードのEscキーを押していただければキャンセルします。

なお、私No3の回答で少しミスをしてしまってます。No3の回答では、InputBoxでキャンセルをクリックすると次回より働かなくなってしまいます。下のソースはその点修正済みです。

Private Sub Worksheet_Change(ByVal Target As Range)
　　On Error GoTo ERREND
　　If Target.Column <> 7 And Target.Column <> 8 Then Exit Sub
　　If Cells(Target.Row, 7).Value = Empty Or Cells(Target.Row, 8).Value = Empty Then Exit Sub
　　Application.EnableEvents = False
　　Application.ScreenUpdating = False
　　Dim 挿入行数 As Long

'必要に応じてこの下の行を編集します------------------------------

　　挿入行数 = 0

'ここまで編集できます--------------------------------------------

　　Do While 挿入行数 = 0
　　　　Tmp = InputBox("挿入する行数を指定してください", "挿入行数", "1")
　　　　If Tmp = Empty Then GoTo ERREND
　　　　If IsNumeric(Tmp) Then 挿入行数 = CInt(Tmp)
　　Loop
　　Rows(CStr(Target.Row + 1) & ":" & CStr(Target.Row + 挿入行数)).Insert _
　　Shift:=xlDown
　　Range(Cells(Target.Row, 1), Cells(Target.Row, 6)).AutoFill _
　　Destination:=Range(Cells(Target.Row, 1), Cells(Target.Row + 挿入行数, 6)), _
　　Type:=xlFillCopy
　　Range(Cells(Target.Row, 7), Cells(Target.Row, 8)).AutoFill _
　　Destination:=Range(Cells(Target.Row, 7), Cells(Target.Row + 挿入行数, 8)), _
　　Type:=xlFillDefault
　　Cells(Target.Row + 挿入行数 + 1, 7).Select

ERREND:
　　Application.ScreenUpdating = True
　　Application.EnableEvents = True
End Sub

補足

ありがとうございます。
少しためしてみましたが、Ｇ列を入力した時にINPUT BOXを
表示し、Ｇ列の値がＳだった場合は何もしないようにするにはどうすればいいでしょうか。

何回もお手数をおかけします。

回答No.5

matsu_jun

4行目と5行目の間

If Cells(Target.Row, 7).Value = Empty Or Cells(Target.Row, 8).Value = Empty Then Exit Sub

と

Application.EnableEvents = False

の間に、以下の1行を追加します。

　　If Cells(Target.Row, 7).Value = "S" Then Exit Sub

""の間の文字を変えてやれば、他の文字にも対応できますよ。
他にも条件があるのであれば、どんどん追記していってください。
例えば、小文字のsも、全角のＳも、全角小文字のｓもということであれば

　　If Cells(Target.Row, 7).Value = "S" Then Exit Sub
　　If Cells(Target.Row, 7).Value = "s" Then Exit Sub
　　If Cells(Target.Row, 7).Value = "Ｓ" Then Exit Sub
　　If Cells(Target.Row, 7).Value = "ｓ" Then Exit Sub

と行を追加していけばよいです。H列も条件に入れたいのであれば、「Target.Row, 7」の部分を
「Target.Row, 8」と書き換えてやればよいだけです。

では、私これからしばらく席を外しますので、他に質問がありましたら、夜中に回答いたしますので宜しくお願いします。

お礼

丁寧に教えていただき、ありがとうございました。
解決いたしました。

回答No.3

matsu_jun

じゃあこういうことですか？
1) 任意の行のC列もしくはD列に入力され、且つその行のC列にもD列にも値が入っていた場合実行
2) 自動的にInputBoxを表示させ、挿入する行の数を入力
3) 入力された数の行だけ下に行挿入
4) A、B列には直上の値をそのままフィル
5) C、D列には直上の値を連番にてフィル
6) C列の、挿入された行の直下のセルをアクティブにする。

それでよければ以下をどうぞ

'ここから-------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
　　On Error GoTo ERREND
　　If Target.Column <> 3 And Target.Column <> 4 Then Exit Sub
　　If Cells(Target.Row, 3).Value = Empty Or Cells(Target.Row, 4).Value = Empty Then Exit Sub
　　Application.EnableEvents = False
　　Application.ScreenUpdating = False
　　Dim 挿入行数 As Long

'必要に応じてこの下の行を編集します------------------------------

　　挿入行数 = 0

'ここまで編集できます--------------------------------------------

　　Do While 挿入行数 = 0
　　　　Tmp = InputBox("挿入する行数を指定してください", "挿入行数", "1")
　　　　If Tmp = Empty Then Exit Sub
　　　　If IsNumeric(Tmp) Then 挿入行数 = CInt(Tmp)
　　Loop
　　Rows(CStr(Target.Row + 1) & ":" & CStr(Target.Row + 挿入行数)).Insert _
　　Shift:=xlDown
　　Range(Cells(Target.Row, 1), Cells(Target.Row, 2)).AutoFill _
　　Destination:=Range(Cells(Target.Row, 1), Cells(Target.Row + 挿入行数, 2)), _
　　Type:=xlFillCopy
　　Range(Cells(Target.Row, 3), Cells(Target.Row, 4)).AutoFill _
　　Destination:=Range(Cells(Target.Row, 3), Cells(Target.Row + 挿入行数, 4)), _
　　Type:=xlFillDefault
　　Cells(Target.Row + 挿入行数 + 1, 3).Select

ERREND:
　　Application.ScreenUpdating = True
　　Application.EnableEvents = True
End Sub
'ここまで-------------------------------------------------------------

今度は別の場所に貼り付けます。以下を参照ください。(Excel2000以降)

1) 目的のシートのタブを右クリックして、「コードの表示(V)」を選択
2) 現れた「Microsoft Visual Basic」の右側の空白の部分に、
　　上の「ここから」から「ここまで」を貼り付ける。
3) Microsoft Visual Basic を終了する。

今度はマクロの実行を行わなくても、セルに値を入力すると自動的に実行します。
また、C列を先に入力しても、D列を先に入力してもOKです。
(両方が埋まった時点で実行しますので)

補足

ありがとうございます。
実際に使用する列はＡ列～Ｆ列までが真上の値をコピー、
Ｇ、Ｈ列が真上の値を連番になります。

後，挿入がない場合がありますので自動的に実行しないようにするにはどうすればよいでしょうか。

よろしくお願い致します。

回答No.2

matsu_jun

ひょっとしてこういうことでしょうか？
とりあえず下のマクロを実行してみてください。

'ここから--------------------------------------------------------------------------
Sub 挿入処理()
　　Dim 挿入行数 As Long

'必要に応じてこの下の行を編集します------------------------------

　　挿入行数 = 0

　　'挿入したい行数を上の行の「0」の代わりに代入します。
　　'0のままだと、実行時に何行挿入するかを尋ねます。
'ここまで編集できます--------------------------------------------

　　Do While 挿入行数 = 0
　　　　Tmp = InputBox("挿入する行数を指定してください", "挿入行数", "1")
　　　　If Tmp = Empty Then Exit Sub
　　　　If IsNumeric(Tmp) Then 挿入行数 = CInt(Tmp)
　　Loop
　　Rows("2:" & CStr(1 + 挿入行数)).Insert Shift:=xlDown
　　Range("A1:B1").AutoFill Destination:=Range("A1:B" & CStr(挿入行数 + 1)), Type:=xlFillCopy
　　Range("C1:D1").AutoFill Destination:=Range("C1:D" & CStr(挿入行数 + 1)), Type:=xlFillDefault
End Sub
'ここまで--------------------------------------------------------------------------

上の貼り付け方が分からない場合は、以下ご覧下さい。

1) ツール(T)－マクロ(M)－新しいマクロの記録(R)を開く
2) 「マクロの記録」ウィンドウが表示されたら、何も変更せずにOKをクリック
3) 画面上に二つのボタンが表示されたツールバーが現れたら、左側の「■」をクリックして記録終了
4) Altキーを押しながらF8キーを押して、マクロウィンドウを開く
5) マクロウィンドウから、編集(E)ボタンをクリック
6) 現れた「Microsoft Visual Basic」の右側に
Sub Macro1()
'
'
'
End Sub
と書いてある部分を削除して、上の「ここから」から「ここまで」を貼り付ける。
7) もう一度Altキー＋F8キーでマクロウィンドウを開き、実行(R)ボタンをクリック

補足

文章があいまいですみません。
結果から書くと

Ａ　　　　 Ｂ　 　 　 Ｃ　　　 Ｄ
１１１　　１１１　Ｍ００１ Ａ００１
１１１　　１１１　Ｍ００２ Ａ００２
１１１　　１１１　Ｍ００３ Ａ００３
２２２　　１１１
３３３　　１１１

Ｃ、Ｄ列の一行目を入れた後に行数（任意）を入力するＩＮＰＵＴ　ＢＯＸを表示させる。同時に上記のようにコピーする。後はＣ、Ｄ列の４行目を入力後繰り返す。
マクロの起動時はＣ、Ｄ列を入力した後です。
よろしくお願いします。

回答No.1

Wendy02

VBとは、VBAのことでしょうけれども、手順として、マクロの範囲が分かりませんし、マクロの起動時がどこか文章では分かりません。(VBですと、EXCELを開けるところから始りますが、VBをお持ちでいなと、こちらは、ソースのみになってしまいます）

C1 に、M001 と D1 にA001 を入力することが、マクロに影響しますか？
(質問文は、それが半角全角混在ですが、それが正しいのですか？）
マクロで入れるのですか？

A1とB1 を、C3:D3 にコピーするのですか？
それとも、C2 の任意の行数を入力した場所に上書きするのですか？
その行数は、セルに直接、ユーザーが入れるのですか？
その連番の増加は、1 なのですか？
それとも、A1～A2, B1～B2 の差の増加率なのですか？

よく分かりませんので、こちらは、独自に解釈して作りました。以下は<該当するシートモジュール>に貼り付けます。

こちらが書いたマクロの内容は、C1 に、M001 と D1 にA001 をユーザーが書き、C2 に、コピーする行数をユーザーが入れる。すると、A2とB2 が、どのような値を持っていても、C2 の数字のコピー数だけA1,B1 の増加率は1として、コピーされる、という内容です。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2" And Range("C1").Value = "M001" And _
Range("D1").Value = "A001" Then
　If Range("C2").Value <= 0 Then Exit Sub
　Range("A1:B2").Copy Range("C3")
　Range("C3:D3").Resize(Range("C2").Value).DataSeries _
　　　　Rowcol:=xlColumns, _
　　　　Type:=xlLinear, _
　　　　Date:=xlDay, _
　　　　Step:=1 '増加率:1
End If
End Sub

したがって結果は、

　C　　D
M001　　A001
2
111　　111
112　　112

となります。

補足

文章があいまいですみません。
結果から書くと

Ａ　　　 Ｂ　 　Ｃ　　 Ｄ
111　　111　　M001 A001
222　　111
333　　111