excel マクロ ○○集計 の下に空白行を2行入れる

質問

Win　XP　Office2000　マクロ初心者です。
エクセル集計機能を使って作った表の太字で表示される○○集計の
行の下に空白行を2行挿入したいのです。
普通に行の挿入をすると○○集計の上に入ってしまいます。
Sub 行の挿入()
Selection.SpecialCells(xlCellTypeFormulas,).Select
Selection.EntireRow.Insert
End Sub
このマクロに何かを加えるとできると思うのですが、よろしくお願いします

回答No.1

Wendy02

こんにちは。

>このマクロに何かを加えるとできると思うのですが、

SpecialCells ですと、返ってややこしいと思います。そこで採れたRangeオブジェクトは、Areas になって一様ではありませんから、分解しなければなりません。数式で取れたRangeオブジェクトは、最終は、「総計」がありますと、そのRangeオブジェクトを一行にしなければなりません。

まして、「集計」という文字は、左隣のセルにありますから、以下のようなマクロになってしまいます。

'-----------------------------------------------------------------
'なるべく、標準モジュールが良いです。

Sub TestMacro1()
Dim rng As Range
Dim i As Long
On Error Resume Next
　 Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
　 If rng Is Nothing Then Exit Sub
On Error GoTo 0

　 For i = rng.Areas.Count To 1 Step -1
　　 If rng.Areas(i).Cells(1).Offset(, -1).Value Like "*集計" Then
　　　　rng.Areas(i).Cells(2, 1).Offset(, -1). _
　　　　　 Resize(2, rng.Areas(i).Columns.Count + 1).Insert xlShiftDown
　　 End If
　 Next i
　　Set rng = Nothing
End Sub

-----------------------------------------------------------------
'単純に、範囲を取って、下から、集計という文字を探すという程度ではどうでしょうか？

Sub TestMacro2()
　Dim rng As Range
　Dim i As Long
　Dim j As Integer
　Set rng = ActiveSheet.Range("A1").CurrentRegion
　j = rng.Columns.Count
　If rng Is Nothing Then MsgBox "範囲の設定を確認してください。", 48
　With rng.Columns(1)
　For i = .Cells.Count To 1 Step -1
　　If .Cells(i, 1).Value Like "*集計" Then
　　　 .Cells(i + 1, 1).Resize(2, j).Insert xlShiftDown
　　End If
　Next i
　End With
　Set rng = Nothing
End Sub

-----------------------------------------------------------------

ただ、こうしたOutline の後の編集は、そのまま行うと後の誤動作の可能性がありますから、最初から、並べ替えで作るか、「集計」をClearしてから、マクロを行ったほうが安全のような気がします。

お礼

お答えありがとうございます。
Sub TestMacro2()の方が良いかもしれません。
それに、思いつきだったので実際集計した表に行を挿入とかは
アウトラインがぐちゃぐちゃになり、使い物になりませんでした。
Wendy02さんのおっしゃるとおりですね。
もう少し考えてみようと思います。
ありがとうございました。