ExcelのVBAで複数行削除を行う場合

Excel2007のVBAで複数行を削除する方法を教えて下さい。

Excel2003で使用していたマクロが使えなくなってしまいました・・・。

下記のようなExcelシートに対して複数行ずつ行を削除し、削除対象が無くなるまで
削除処理を行うか、指定した行まで削除処理を行うという事をしたいのですが
うまく動きません。

例
　　　　　A列　　　B列　　　C列　　　D列　　　E列
1行目 aaa1　　　bbb1　　ccc1
2行目 　 　　　　　　　　　 ccc2
3行目 　 　　　　　　　　　 ccc3
4行目 　 　　　　　　　　　 ccc4
5行目 aaa2　　　bbb2　　ccc1
6行目 　 　　　　　　　　　 ccc2
7行目 　 　　　　　　　　　 ccc3
8行目 　 　　　　　　　　　 ccc4


例に対しての結果
　　　　　A列　　　B列　　　C列　　　D列　　　E列
1行目 aaa1　　　bbb1　　ccc4
2行目 aaa2　　　bbb2　　ccc4

例に対して、複数行(指定した行数ここでは3行)の削除を行いたいのですが、
単純に複数行(3行)ずつ削除していくのではなく。
1行目や5行目にあるように文字や情報が入力されているA列とB列の情報は
残しつつ、4行目のC列以降の列の情報はすべて活かしていくという事をしたいのです。

Excel2003の時に使用していたVBAは以下のものです。

Sub 行を削除するマクロ()
Workbooks("xxxx.xlsx").Activate '処理を行いたいExcel ※１
n = n + 0
LastRow = 2138 　　　　　　　　　 '処理を終了させたい行 ※２

Sheets("Sheet1").Select '処理を行いたいシート ※３
Do Until (n > LastRow)
Rows(n + 4).Delete Shift:=xlsiftUp '削除したい行指定 ※４
n = n + 3

Loop
End Sub


皆様の良いアドバイスやお知恵をお貸しください。
よろしくお願いします。

No.14 回答者： layy 回答日時： 2011/02/05 01:16

＞理解力が足りず

何度もこう書いていますが、
自分であまり書けないうちは、他の人のプログラムも理解しにくいもの。
「やりたいこと→使うコマンド」、「使われているコマンド→される内容」、この相互の翻訳ができてない。
コードを見たときは、「使われているコマンド→される内容」の力は増していくだろうが、
「やりたいこと→使うコマンド、構文」の力があまりつかない。
実際は機能から考えるので「やりたいこと」から思いつくはず。
「ｘｘｘのコマンド」を使って例題を作れ、でもない。


＞永久ループに近いような状態になり、動いていないようなっているらしいという事と、

プログラミングは、やりたいことをさせるだけじゃありません。
途中どこまでできているか等処理状況を明示させることだってできます。
MSGBOX（"ｘｘｘ行から始めます"）
MSGBOX（"ｘｘｘ行まで終わりました"）


これは個人的見解なのでー、自分で進め方を改めて考えてみると良い。

No.13 回答者： layy 回答日時： 2011/02/04 21:47

＞最後の４行

事象の説明としては不十分です。
これがもともと１番下のグループでの４行であるとき
→最初のループでうまく処理できていないからで
ループの初回、初期値がおかしい可能性あり、と考えられる

これが１番上のグループでの４行であるとき
→最後のループであるからして、
ループの終了回判定がおかしい可能性あり、と考えられる

デバッグ（１行ずつの実行、途中の値の検証等）や、
トレースをする、これを学ぶと良い。

１回目のループでどうなる、
２回目のループでどうなる、
３回目のループでどうなる、
・・・・
最終の１つ前ならどうなる、
最終ならどうなる、
こういうロジックのイメージを考え、理解した上でコードを書き始めると、
基本的な部分はほぼ間違いなく動く。間違えるのは記入間違い程度。

組立しないでいきなりコードを見る、使うというのは、どこがどうおかしいか発見が遅い。
人のプログラムを見るのも、慣れるまではじっくり見ないことには初心者には辛い。

いきなり動く結果を急ぐのもわからないでもない。
それでも疑問、確定した部分を１つずつ解決していくのがより効果大。
トータル、今後のことまで考えると逆効果になりかねない。
回答のコード、実際使った（失敗分含めた）コード例を活かすかどうかにも依存する。



以下のようなサイトのコラムをよーく読むこと。
エクセルでお仕事（の特にＶＢＡ基本）
http://www.asahi-net.or.jp/~ef2o-inue/menu/menu0 …
すぐに役立つエクセルマクロ集
http://www.asahi-net.or.jp/~zn3y-ngi/YNxv20.html
ほか
ＶＢＡコマンド
http://www.voicechatjapan.com/excelvba/VBArei2.htm

「ｔｉｐｓ」というキーワードでもいろいろ拾える。

今後もＶＢＡでプログラムをしたい、
ちょっとしたことでも対処できるようにしたい、というなら特に。

＞皆様の良いアドバイスやお知恵

少しでも自分のものにして行く。

No.12 回答者： imogasi 回答日時： 2011/02/04 20:29

こういう問題は、一旦VBAのコードを離れて、どういうロジック（着眼点）で行うかを、じっくり自分で考えて、修行すべきなんだ。

直ぐ他人に聞くと訓練にならない。
十人十色と言うが、いろんなやり方が在りうる。
私なら
（大筋）
削除しないで、抜き出し的に別シートに必要データで表を作る。
ーー
《変数）
Sheet2の書き出し行をポイントする変数　下記でmae
Sheet1で直前の行のC列を保持する半数 下記でp
を設ける
ーー
(ロジック）
C列の最終行を求める。
の行まで、１行ずつ　全行について処理を繰り返す。For Nextループ。
A列で判別し非空白セル行が見つかったとき
ーーーA列B列をSheet2A列B列に転記。
　　C列データだけは変数に保持。
A列で判別し空白セル行であるとき
ーーー何もしない（読み飛ばし）。C列データだけは変数に保持。
以上が基本。
ただし、A列で非空白セル行が見つかったとき
ーーSheet2のC列に変数maeのデータを記録し、行ポインタを＋１（直下を指す）
例データ　Sheet1
XYZ
aaa1bbb1ccc1
ccc2
ccc3
ccc4
aaa2bbb2ccc1
ccc2
ccc3
ccc4
aaa3bbb3ccc1
aaa4bbb4ccc1
ーー
コード
Sub test02()
Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
'--
d = sh1.Range("C65536").End(xlUp).Row
MsgBox d
p = 1
For i = 2 To d
If sh1.Cells(i, "A") = "" Then
mae = sh1.Cells(i, "C")
Else
sh2.Cells(p, "C") = mae
p = p + 1
sh2.Cells(p, "A") = sh1.Cells(i, "A")
sh2.Cells(p, "B") = sh1.Cells(i, "B")
End If
mae = sh1.Cells(i, "C")
Next i
sh2.Cells(p, "C") = mae
End Sub
ーー
結果　Sheet2 第1行目の見出し文字は省略
aaa1bbb1ccc4
aaa2bbb2ccc4
aaa3bbb3ccc1
aaa4bbb4ccc1

No.11 回答者： Wendy02 回答日時： 2011/02/04 16:18

#8の回答者です。

正直なところ、参りました。私が読み違えたのでしょうか？どうやら、C列はC列なのですね。「C列をZ列迄にした場合にしようと、」という言葉が、C列にあるものを、Z列に移したと解釈しました。それだけで、言葉の意味を理正確に解出来る人がいるのは、驚きました。あくまでも、言葉に忠実にと考えて書いていますが、私は、そこまでの先読みは不可能です。言葉を端折らずに、もう少し丁寧に説明していただいたほうが、お互いのためだと思います。きちんと説明出来るのも、実力の内かもしれませんね。

#4のマクロの最後の部分を、以下のように入れ替えればよいと思います。

　With ash
　　.Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1), .Cells(Rows.Count, 3).End(xlUp)).ClearContents
　　.Range(.Cells(1, 4), .Cells(Rows.Count, 5).End(xlUp).Offset(, 22)).ClearContents
　End With
　Application.ScreenUpdating = True
End Sub
'---------

#6 様の部分で、
>最後の加工したい範囲(4行分)だけ取り残されて終了してしまいます。
#Cells(Rows.Count, 3).End(xlUp)
となっていますから、おそらく、基準となる、列が違うのでしょうし、こちらのものを直しても、同じようになるはずです。ここでは、3列目になっています。ご自身で加工出来るレベルなら、もうとうに解決されているはずです。以下の方法は、誤動作する可能性が強いです。

　'Workbooks("xxxx.xlsx").Activate 'ブックを指定
　Set ash = ActiveSheet 'シートを決める
　With ash
　　'Set rng = .Range("C1", .Cells(Rows.Count, 3).End(xlUp))　'この代わりに以下にする
　　Set rng = .Range("C1", .Cells(.Range("C1").SpecialCells(xlCellTypeLastCell).Row, 3))
　End With

No.10 回答者： layy 回答日時： 2011/02/04 15:01

最後の塊だけが残るというのは、普通は『あと１回分ループして判定したら終わる』はずで、ループの終了条件を直すかループが終わった後でループ内と同じことさせるか、で直ります。

質問にあげたデータ例で
たった４行目まで１グループ分しかないとき空振りして終わるのでは？。限界境界チェックです。

No.9 回答者： layy 回答日時： 2011/02/04 12:07

＞何したら？

質問に自身が書いた通り機能は明確、『単純に複数行ずつ削除でなく～』でしょう？。
この３ずつでなくなるｎの求め方に着目すれば良いし、基準行と次の行の値が変わったか？とか空か？とかの判断をどう表現するか、そんなところ。

提示あるコード例でそんなロジックがどうなっているか、とか見ていますか？。

人のを見るより自身で作りかけたものを修正するのがわかりやすい、のでしょう。

今はどの状態のコードにどう修正しようと取り組んでますか。見ているものが違うと回答ズレます。

この回答へのお礼

回答とアドバイスをありがとうございます。

一応、自分なりにそれぞれ教えて頂いたものを試して、
内容を理解するようにして自身で修正してみたりしてみました。

只、私の理解不足の問題で何を何処で行っているのか理解できない
部分があり、何をどうしたらという表現になりました。

今は、tom04さんのロジックを基に色々試してみています。

お礼日時：2011/02/04 14:57

No.8 回答者： Wendy02 回答日時： 2011/02/04 11:07

#4の回答者です。

>私には何処をどうやって改良したら良いやら？
「改良」ですか？手を付ける部分がないほど、酷いマクロでしょうか？たぶん、改変とかだと思いますが、私は、基本的には、フォルダやブック名やシート名などの固有の情報以外の部分を質問者さんに直していただくようなコードは書きません。変更するなら、問い合わせしてください。また、サンプルデータがあるなら、そのサンプルデータを試していただいてからにしてください。時々、見ただけで、ダメだしする人がいますが、常識外です。基本的に元の質問に対する解決を目的としています。ある程度の想定はしても質問に出ていない部分は予測不可能です。一応、物理的な幅の範囲(ただし、最後の列を使いますから、Excel 2003までなら、255列までです）なら可変にしました。着目はスピードですから、一回しか行の削除はしません。ただし、最終列は、1列だけしか残りません。内容的には、記録マクロに毛が生えた程度の誰でも出来る初級のマクロです。

なお、シートを間違えた時にエラー処理は施していません。

'//標準モジュール
Sub Test2()
　Dim rng As Range
　Dim r1 As Range
　Dim ash As Worksheet
　Dim rw As Long
　Dim cl As Long
　Dim cln As Long
　Dim r As Range
　'Workbooks("xxxx.xlsx").Activate '必要に応じてブックを指定
　Set ash = ActiveSheet　'必要に応じてシート名を入れる
　With ash
　　Set r1 = .UsedRange.Cells(1, 1)
　　cl = .Cells(1, Columns.Count).End(xlToLeft).Column
　　rw = .Cells(Rows.Count, cl).End(xlUp).Row
　　Set rng = .Range(.Cells(r1.Row, cl), .Cells(rw, cl))
　　cln = .Range(r1, .Cells(r1.Row, cl)).Columns.Count
　End With
　With rng
　　.Offset(1, 1).Formula = "=IF(COUNTA(R[1]C" & r1.Column & ":R[1]C[-1])=" & cln & ",MAX(R1C:R[-1]C)+1,"""")"
　　ash.Cells(rw, cl + 1).Formula = "=MAX(R1C:R[-1]C)+1"
　　.Offset(1, 1).Value = .Offset(1, 1).Value
　　.Resize(, 2).Sort Key1:=.Range("B1"), _
　　Order1:=xlAscending, Header:=xlNo, OrderCustom:=1
　　.Offset(, 1).ClearContents
　End With
　Application.ScreenUpdating = False
　With rng.Offset(, 1 - cln).Resize(, cln - 1)
　　On Error Resume Next
　　'もし、空白間にデータがないなら、このループは不要
　　For Each r In .SpecialCells(xlCellTypeBlanks).Rows
　　　If r.Columns.Count <> cln - 1 Then
　　　ash.Cells(r.Row, r1.Column).Resize(, cln - 1).ClearContents
　　　End If
　　Next r
　 .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
　　If Err.Number > 0 Then Exit Sub
　　On Error GoTo 0
　End With
　With ash
　　.Range(.Cells(Rows.Count, r1.Column).End(xlUp).Offset(1), .Cells(rw, cl)).ClearContents
　End With
　Application.ScreenUpdating = True
　Set rng = Nothing: Set ash = Nothing
End Sub

この回答へのお礼

回答ありがとうございます。

最初に、教えて頂いたものはもちろん試してみたのですが、
最後の行の処理が私の意図する形と違っていた為、
私なりに直そうとしたのですが、私にはロジックが高度過ぎて
何処を直せば意図する形になるのか、全くもって???というと
次第です。

また、今回教えて頂いたものを試させて頂いたのですが、
全ての行が消えてしまいやはり私には何処をどう直せば
良いのやら???な次第です。

すみません、初級のマクロという事ですがVBAをちょっちだけしか
理解していない私にはせっかく教えて頂いているのに、
理解不足ですみません。

お礼日時：2011/02/04 14:48

No.7 回答者： layy 回答日時： 2011/02/04 09:36

試すばかりでは時間の無駄ですね。

また、仕様、ロジックの説明なければしてもらう。
説明だけで後は自分でコードを書く、のが良いです。コードみてからの説明では手順は逆なので実行できても疑問は解決されないこと多々ある。
これがわかってないからコードを思い描くのが先になるのだろう。


CELLS(i-1,3)=CELLS(i,3)
の3は3番目のＣ列を意味します。なので、５行目で４行目削除したらＣ５の値をＣ４にセット、４行目で３行目削除したらＣ４の値をＣ３にセット、の繰り返し。Ｄ列からＺ列まであればＣ列と同じ編集をしてやる。

No.6 回答者： tom04 回答日時： 2011/02/04 09:12

No.1です！

前回のコードはA～C列まででしたが、データはZ列まであるわけですね？
前回の操作をC～Z列すべてに当てはめれば良いという解釈でやってみます。
1行目はタイトル行で2行目からデータがあるとします。

考え方としては
（1）データの最終行（C列の最終行）から順番に上の行に検索を行う
（2）A・B列が空白の場合、その行の1行上のC～Z列のデータを削除し上へシフト
（3）（2）の場合、その行のA・B列を削除し上へシフト（A・B列の空白セルを削除）
（4）上記の操作を最終行から2行目まで行う

という感じでやってみました。

Sub test()
Dim i As Long
For i = Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
If Range("A" & i) = "" And Range("B" & i) = "" Then
Range("C" & i - 1, "Z" & i - 1).Delete (xlUp)
Range("A" & i, "B" & i).Delete (xlUp)
End If
Next i
End Sub

こんなんではどうでしょうか？m(__)m

この回答へのお礼

更に、分かりやすい回答をありがとうございます。

大変丁寧に教えて頂いたおかげで、自分のやりたい事に対して
何処をどうしたら良いのかの理解ができました。
早速、自分の動かしたい形に少し改良(改変?)してみたところ
ほぼ100%に近い動きになりました。

ほぼ100%というのは、最後の加工したい範囲(4行分)だけ取り残されて
終了してしまいます。
最後の範囲のみなので、手動で作業を行っても良いのですがこの作業を
行いたいシートというかExcelが沢山あるので、出来れば最後の範囲も
取り残されずに終了する事は可能でしょうか?

すみません、何度も何度も・・・。

また、2007の機能?というか性能というか弱点?なのでしょうか。
新規に作成したシートにデータが入っている場合は、
今回教えて頂いたもので機能的に行や列の削除を行うのですが。

新規のままのシートではなく原本のシート全体をcopyし、
それに対して加工したシートに対したものに使用すると、
列や行を最後の行までみてしまうらしく、動きがものすごく
遅くなるという事がわかりました。

という事で、教えて頂いたロジックに自分のしたい事を追加し、
この作業の前にいらない行と列の削除を行うというものにしてみました。
これに関しても、何か良い案というかお知恵を拝借する事は可能でしょうか?

お礼日時：2011/02/04 14:16

No.5 回答者： layy 回答日時： 2011/02/03 22:53

1行目 aaa1　　　bbb1　　ccc1

2行目 aaa2　　　bbb2　　ccc2
3行目 　　　bbb3　　ccc3
4行目 aaa3　　　bbb4　　ccc4
が発生するかもしれないときの対応、も。

グループ分けが増えても減っても対応が容易にできるのがベターです。。