みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

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 ※1
n = n + 0
LastRow = 2138           '処理を終了させたい行 ※2

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

Loop
End Sub


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

投稿日時 - 2011-02-03 20:57:42

QNo.6495759

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(14)

ANo.14

>理解力が足りず

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


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

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


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

投稿日時 - 2011-02-05 01:16:46

ANo.13

>最後の4行

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

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

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

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

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

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



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

「tips」というキーワードでもいろいろ拾える。

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

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

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

投稿日時 - 2011-02-04 21:47:51

ANo.12

こういう問題は、一旦VBAのコードを離れて、どういうロジック(着眼点)で行うかを、じっくり自分で考えて、修行すべきなんだ。直ぐ他人に聞くと訓練にならない。
十人十色と言うが、いろんなやり方が在りうる。
私なら
(大筋)
削除しないで、抜き出し的に別シートに必要データで表を作る。
ーー
《変数)
Sheet2の書き出し行をポイントする変数 下記でmae
Sheet1で直前の行のC列を保持する半数 下記でp
を設ける
ーー
(ロジック)
C列の最終行を求める。
の行まで、1行ずつ 全行について処理を繰り返す。For Nextループ。
A列で判別し非空白セル行が見つかったとき
ーーーA列B列をSheet2A列B列に転記。
  C列データだけは変数に保持。
A列で判別し空白セル行であるとき
ーーー何もしない(読み飛ばし)。C列データだけは変数に保持。
以上が基本。
ただし、A列で非空白セル行が見つかったとき
ーーSheet2のC列に変数maeのデータを記録し、行ポインタを+1(直下を指す)
例データ 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

投稿日時 - 2011-02-04 20:29:43

ANo.11

#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

投稿日時 - 2011-02-04 16:18:34

ANo.10

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

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

投稿日時 - 2011-02-04 15:01:17

ANo.9

>何したら?

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

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

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

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

投稿日時 - 2011-02-04 12:07:46

お礼

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

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

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

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

投稿日時 - 2011-02-04 14:57:33

ANo.8

#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

投稿日時 - 2011-02-04 11:07:13

お礼

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

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

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

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

投稿日時 - 2011-02-04 14:48:33

ANo.7

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


CELLS(i-1,3)=CELLS(i,3)
の3は3番目のC列を意味します。なので、5行目で4行目削除したらC5の値をC4にセット、4行目で3行目削除したらC4の値をC3にセット、の繰り返し。D列からZ列まであればC列と同じ編集をしてやる。

投稿日時 - 2011-02-04 09:36:14

ANo.6

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

投稿日時 - 2011-02-04 09:12:07

お礼

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

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

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

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

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

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

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

投稿日時 - 2011-02-04 14:16:08

ANo.5

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

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

投稿日時 - 2011-02-03 22:53:46

ANo.4

'標準モジュール
Sub Test1()
 Dim rng As Range
 Dim ash As Worksheet
 Workbooks("xxxx.xlsx").Activate 'ブックを指定
 Set ash = ActiveSheet 'シートを決める
 With ash
  Set rng = .Range("C1", .Cells(Rows.Count, 3).End(xlUp))
 End With
 With rng
  .Offset(1, 1).Formula = "=IF(R[1]C[-2]<>"""",MAX(R1C:R[-1]C)+1,"""")"
  .Offset(1, 1).Value = .Offset(1, 1).Value
  ash.Cells(Rows.Count, 3).End(xlUp).Offset(, 1).Formula = "=MAX(R1C:R[-1]C)+1"
  .Resize(, 2).Sort Key1:=.Range("B1"), _
  Order1:=xlAscending, Header:=xlNo, OrderCustom:=1
  .Offset(, 1).ClearContents
 End With
 Application.ScreenUpdating = False
 With rng.Offset(, -2).Resize(, 2)
  On Error Resume Next
  .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
  If Err.Number > 0 Then Exit Sub
  On Error GoTo 0
 End With
 With ash
  .Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1), .Cells(Rows.Count, 3).End(xlUp)).ClearContents
 End With
 Application.ScreenUpdating = True
End Sub

投稿日時 - 2011-02-03 22:14:25

お礼

回答ありがとうございます。
すみません、VBAの理解力がほとんど無い為、
せっかく教えて頂いたのに、私には何処をどうやって改良したら良いやら?

投稿日時 - 2011-02-04 01:34:31

ANo.3

当然
1行目 aaa1   bbb1  ccc1
2行目 aaa2   bbb2  ccc2
3行目 ccc3
4行目 aaa3   bbb3  ccc4

1行目 aaa1   bbb1  ccc1
2行目 ccc2
3行目 ccc3
4行目 ccc4

確認事項に含めたいですね。

投稿日時 - 2011-02-03 22:12:49

ANo.2

1)
行削除(Rows(n + 4).Delete )発行は処理を遅くする要因です。
行削除に関しては、過去にも質問多数あります。

2)
最終行から逆に操作していく方が、その削除に対応しやすい。
(基準になる行位置が順に下がっていき流動的でないため)

3)
上から順に1行ずつ、値を退避する、空値は退避しない、
そこで5行目に来たとき、それまで退避しておいた
aaa1   bbb1  ccc4
を出力対象とするロジック。
コントロールブレイクの基本形。ロジックの定番。

4)
削除といいつつもマークして、該当行だけ別シートへ移す、
結果は同じものが得られる

5)
1行目 aaa1   bbb1  ccc1
2行目 aaa1   bbb1  ccc2
3行目 aaa1   bbb1  ccc3
4行目 aaa1   bbb1  ccc4
5行目 aaa2   bbb2  ccc1
6行目 aaa2   bbb2  ccc2
7行目 aaa2   bbb2  ccc3
8行目 aaa2   bbb2  ccc4
と作業しやすいシートをいったん作る

観点はいろいろあります。

投稿日時 - 2011-02-03 21:54:51

お礼

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

VBAの行削除に関して、色々探してみたり調べてみたりしたところ、
ご指摘頂いている処理が遅く(重く)なる要因の部分で、
永久ループに近いような状態になり、動いていないようなっているらしいという事と、
削除するなら最終行からに変更しなさいというのは分かるのですが、
VBAの理解力が足りず何処をどう変更すれば良いか・・・。

投稿日時 - 2011-02-04 01:48:27

ANo.1

こんばんは!
データはA~C列までとして・・・
ごくごく単純にやってみました。
操作したいSheet見出し上で右クリック → コードの表示 → VBE画面に↓のコードをコピー&ペーストしてマクロを実行してみてください。

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

深く考えていませんので、的外れならごめんなさいね。m(__)m

投稿日時 - 2011-02-03 21:48:53

お礼

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

全然的外れじゃないです。
早速試させて頂いたところ、私のやりたい事にとても近いです。
只、私の理解力が足りずC列をZ列迄にした場合にしようと、
私なりに色々試してみたのですが、VBAセルの因数の設定の
仕方が分からず・・・。

大変申し訳ありませんが、C列以降の列でも動くようにするには
何処の因数を変えれば良いのでしょうか?

投稿日時 - 2011-02-04 01:27:47

あなたにオススメの質問