単純なものでも、はまってしまう時ははまってしまうのがマクロです。 先日、職場の人からこんなマクロ(VBA)の相談を受けました。
実際は1000行くらいあり、列も20列くらいあったのですが、単純な作業といえば単純な作業です。最初できたのはこんなコードでした。
<ちょっとカッコ悪いコード>
Sub 連続して4行に増やす()
'最終行の取得
Dim LstRow As Long
LstRow = Cells(Rows.Count, 1).End(xlUp).Row
'繰り返し処理
For i = LstRow To 2 Step -1
Rows(i).Select
Application.CutCopyMode = False
Selection.Copy
Selection.Insert Shift:=xlDown
Selection.Copy
Selection.Insert Shift:=xlDown
Selection.Copy
Selection.Insert Shift:=xlDown
Next
End Sub
このコードだと、3行ふやしたり、4行増やしたりといった調整にいちいちVBAのコードをいじらなければなりません。そこで汎用的なコードを作成しました。
<汎用的なコード>
Sub 同一行コピーを増やして連続させる()
'A列最終行の取得(LstRow = Cells()の中の1を調整。Bなら2)
Dim LstRow As Long
LstRow = Cells(Rows.Count, 1).End(xlUp).Row
'最終的な行数をInputBoxから取得
Dim a As Long
a = Application.InputBox("最終的に何行にしますか?", Type:=1)
'InputBoxの引数が2より小さ場合、終了する。
If a < 2 Then
MsgBox "有効でない数値が入力されました。"
End
End If
'aを増やす行数に変換する。
a = a - 1
'繰り返し処理(見出し行ありを「LastRow to 2」で調整、見出しがなければ「to 1」)
For i = LstRow To 2 Step -1
Rows(i).Select
Selection.Copy
Rows(i + 1 & ":" & i + a).Select
Selection.Insert Shift:=xlDown
Next
End Sub
1)InputBoxが開いて、最終的な行数を入力すれば良いので楽です。
2)考え方はExcelを1行コピーして複数行にペーストする次のやり方をべーすにしてマクロを組んでいます。