Ｅｘｃｅｌｌ ＶＢＡ：dataに空白行を挿入したい。

質問

Ａ列のデータが違うところで、空白を開けたいのですが、どうすればいいのでしょうか。よろしくお願いします。
データの行数は不定です。

１　ｔ１　　＊＊　　＊＊
２　ｔ２　　＊＊　　＊＊
３　ｔ２ 　 ＊＊　　＊＊
４　ｔ３ 　　＊＊　　＊＊

　を
１　ｔ１　　＊＊　　＊＊
２
３　ｔ２　　＊＊　　＊＊
４　ｔ２　　＊＊　　＊＊
５
６　ｔ３ 　＊＊　　＊＊
７
８　ｔ４

　にしたい。

回答No.4

nishi6 · ベストアンサー

＞データの行数は不定です

ということなので補足しておきます。下記マクロで不定行数でも大丈夫です。
また、元のA列の並びの中に未入力行があるとうまくいきません。下記では最初に未入力行を削除し、その後で行挿入を行っています。参考までに。

Sub GyoSonyu2()
　　Dim rw As Long 'A列のセル
　　Dim rwCount As Long 'A列の値が登録された最後の行番号

　　Application.ScreenUpdating = False
　　'A列のセルが未入力ならその行を削除
　　rwCount = Range("A:A").SpecialCells(xlCellTypeLastCell).Row
　　For rw = rwCount To 2 Step -1
　　　　If Cells(rw, 1) = "" Then
　　　　　　Rows(rw).Delete
　　　　End If
　　Next

　　'A列でセルの値とその前のセルの値が違えばば行挿入
　　rwCount = Range("A:A").SpecialCells(xlCellTypeLastCell).Row
　　For rw = rwCount To 2 Step -1
　　　　If Cells(rw, 1) <> Cells(rw - 1, 1) Then
　　　　　　Rows(rw).Insert
　　　　End If
　　Next
　　Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。
返事、遅れてすいません。
みごとですね。
そのまま、使わせていただきます。
勉強になりました。

　ありがとうございました。

回答No.3

brogie

VBAで解らない時は、マクロを新規に作成して、そのプログラムを編集で見ると解ります。
やり方はお分かりと思いますが、念のため書いておきます。
「1行を挿入するマクロ」です。

１．「ツール」「マクロ」「新しいマクロの記録」を順にクリックしていきます。
２．「ショートカットキー」を入力して、「OK」
３．「行番号」をクリックして、
４．「挿入」「行」をクリック
５．「マクロ終了ボタン」をクリックして終了です。

「マクロ記録終了」ボタンが表示されていないときは、「表示」「ツール」「記録終了」をクリックすると、表示されます。

つぎに、「ツール」「マクロ」「マクロ」「編集」で
プログラムが表示されます。

これを読むとどのようにプログラムすればよいかわかります。

老婆心ながら・・・・

参考URL：

http://www2.odn.ne.jp/excel/index.html

お礼

ありがとうございます。
そうやれば、簡単にできるんですね。
なにしろ、初心者なもので、
知りませんでした。
参考になりました。
　ありがとうございました。

回答No.2

bin-chan

telmiさん、おはようございます。
前回のご質問の反対ですね。

行番号を削除しなければ、簡単なのに・・・。
（行番号ソートでもとに戻ったはずですよ）

行番号を付与しない方法です。
[データ]-[集計]を利用します。

１．見出し行を追加します。
２．[データ]-[集計]をクリックします。
３．[グループの基準]にｔの値の列を指定します。
４．[集計の方法]は合計でもデータの個数でもＯＫ。
５．[集計するフィールド]の適当でＯＫ。
６．ダイアログの[ＯＫボタン]を押下。
７．集計表が表示されますから、左側に追加表示された集計レベル（正式名？）の
　　「２」をクリックします。
８．グループの計の行だけが表示されますから、１行ごとに内容を消去してください。
　　ここで一度にすべて消去すると肝心のデータも消えます。
　　必ず１行ごとに消去してください。
９．集計レベル（正式名？）の「３」をクリックします。
　　各グループの計の行が「空白行」となりました。
１０．シート全体をコピーし、別シートに[形式を選択して貼り付け]-[値]でＯＫ。

えいやっ！で実現する、姑息な手段です。

お礼

返事、遅れてすいません。
なるほど。
そんなやりかたが、あるんですね。
面倒ですがそれで、できますね。
参考になりました。
　ありがとうございました。

回答No.1

nishi6

こんな感じですか。

Sub GyoSonyu()
　　Dim rw As Long

　　For rw = 4 To 2 Step -1
　　　　If Cells(rw, 1) <> Cells(rw - 1, 1) Then
　　　　　　Rows(rw).Insert
　　　　End If
　　Next
End Sub

お礼

毎度ありがとうございます。