Excel 空白行を上に詰めるマクロ

関数を使用して、sheet1からsheet2に必要なデータを抜き取りました。
sheet２のセルには関数が入っています。

sheet2の抽出データには１行単位（まれに２～３行続けて）空白が発生します。
この行を削除し、かつ上に詰めて表示をしたいのですが、下記の条件で実行可能でしょうか？

（例）
sheet1 ⇒ sheet2
　　A　 　B　　 C　　　　　A　　B　　C
1　あ　　い　　う　　　1　あ　　い　 か
2　　　　　 　　か　　　2　（空白行）
3　き　　く　 　け 　　 3　き　　く　　し　　
4　こ　　さ　　 し　　 4 （空白行）

●２行目、４行目を削除し、且つ５行目以降に入力されている関数は削除したくない
●空白行削除のマクロは自動？（sheet1のデータを変更したら）で実行できるようにしたい

よろしくお願いします。

No.1 ベストアンサー 回答者： nda23 回答日時： 2011/02/08 12:45

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Sh.Name = "Sheet1" Then
　　　　Dim 最終行 As Long
　　　　Dim 最終列 As Long
　　　　Dim 行　　　　 As Long
　　　　Dim 列　　　　 As Long
　　　　Dim 行位置 As String
　　　　With ThisWorkbook.Worksheets("Sheet2")
　　　　　　　　最終行 = .Cells.SpecialCells(xlCellTypeLastCell).Row
　　　　　　　　最終列 = .Cells.SpecialCells(xlCellTypeLastCell).Column
　　　　　　　　Do
　　　　　　　　　　　　行 = 行 + 1
　　　　　　　　　　　　For 列 = 1 To 最終列
　　　　　　　　　　　　　　　　If .Cells(行, 列) <> "" Then Exit For
　　　　　　　　　　　　Next
　　　　　　　　　　　　If 列 > 最終列 Then
　　　　　　　　　　　　　　　　行位置 = CStr(行) & ":" & CStr(行)
　　　　　　　　　　　　　　　　.Rows(行位置).Delete Shift:=xlUp
　　　　　　　　　　　　　　　　最終行 = 最終行 - 1
　　　　　　　　　　　　　　　　行 = 行 - 1
　　　　　　　　　　　　End If
　　　　　　　　Loop While 行 < 最終行
　　　　End With
End If
End Sub

ブックのイベントプロシージャとして上記を
コピペすれば動作すると思います。
但し、行が詰まってもセルの数式に指定された
行は変更されないので、注意が必要です。
これを変更するにはもう少し手を入れます。

この回答へのお礼

回答いただきありがとうございます。
こちらを参考にし解決できました。

お礼日時：2011/02/10 00:39

No.3 回答者： imogasi 回答日時： 2011/02/08 13:31

＞２行目、４行目を

Sheet2のことだよね
その行の全列が空白セルの場合に限りだよね。
ーー
質問の１－４行は、場合によっては５，６，７・・と増えたり減ったりするのか？
しっかり書いておくこと。
ーー
＞５行目以降に入力されている関数は削除したくない
５行目以降は触らなくて良いのだね。
＞自動？（sheet1のデータを変更したら）
１－４行目のデータ入力が完了したと言うキッカケを、プログラム側へ伝えることが必要だと思う。
だからコマンドボタン等シートに設けることが行われる。外にショートカットキーとか、高等なことは沢山あるが。
ボタンを使うにしても、質問の書き方のあいまいさ、からして、VBA、イベントプロシージャ作成の経験ないのでは。
ボタンをクリックしたイベントに
下の行から空白行かどうか判断して、空白行なら、その行を行削除すればよい。
例えば
下記は都度実行する形式。イベントプロシージャではない。
Sub test02()
For i = 4 To 1 Step -1
For j = 1 To 3
If Cells(i, j) = "" Then
Else
'データあり、行削除可能性消えたし
GoTo skp
End If
Next j
MsgBox i & "目行削除"
Rows(i).EntireRow.Delete
skp:
Next i
End Sub
ーーー
５行以下の関数で、１－４行の番地を参照している場合、行削除で５行目以下の関数式は、自動で番地が変わってくれると思うが、正確にはやってみないとわからない。
以上、この質問は不完全な点があり、確信のもてる答えは出来ないタイプ。

No.2 回答者： kagakusuki 回答日時： 2011/02/08 13:15

　元々関数を使用していて、且つ、元の関数を残したいのでしたら、関数を使用して別のシートに結果を表示させても宜しいのではないでしょうか。

　例えば、まず、Sheet2のD1セルに次の数式を入力してから、Sheet2のD1セルをコピーして、Sheet2のD2以下に貼り付けておきます。

=IF(COUNTIF(INDIRECT("R"&ROW()&"C1:R"&ROW()&"C"&COLUMN(),FALSE),"><")=0,"",ROW())

　次に、例えばSheet3のA1セルに次の数式を入力します。

=IF(ROW()>COUNT(Sheet2!$D:$D),"",IF(INDEX(INDIRECT("Sheet2!A:C"),SMALL(Sheet2!$D:$D,ROW()),COLUMN())="","",INDEX(INDIRECT("Sheet2!A:C"),SMALL(Sheet2!$D:$D,ROW()),COLUMN())))

　そして、Sheet3のA1セルをコピーして、Sheet3のA列～C列の各セルに貼り付けておきます。
　そうすれば、Sheet2の関数を一切削除する事なく、Sheet2のA列～C列の空白行を詰めた表示を、Sheet3に表示する事が出来ます。