エクセル：複数シートの一括処理

質問

お世話になります。
エクセルで１つのブックに複数のシートがあります。
書式は同じですが行数がそれぞれ違います。
Ａ列で、データが入力されている一番下のセルの次の行から、エクセルの最終行である６５５３６行までの行を全て選択して「削除」をしたいのです。（行の削除）しかも全シート一括で。
Ａ列でデータが入っている一番下のセルがＡ５５０だった場合、５５１行～６５５３６行までを全て選択→削除を行う。
これらの作業をするためのマクロを教えてください。

回答No.4

ham_kamo · ベストアンサー

No.1です。補足拝見しました。
なるほど、目に見えない空文字列があるのですね。
以下のマクロでどうでしょうか。

Sub Sub 一括削除()
　Dim WS As Worksheet
　Dim EndRow As Long
　For Each WS In Worksheets
　　With WS
　　　EndRow = .Columns("A:A").Find(What:="*", LookIn:=xlValues, _
　　　SearchDirection:=xlPrevious).Row + 1
　　　.Rows(EndRow & ":" & Rows.Count).Delete
　　End With
　Next
End Sub

お礼

ありがとうございます。
期待通りの結果が出ました。

回答No.7

Wendy02

こんばんは。#6のWendy02です。

私には、あれこれと、いろんなトラブルを考えて作ったつもりですが、それでダメだという原因は、よく分かりません。

>単純にＡ列の最終行の一つ下セルからエクセルに一番右下の　IV65536セルまでを選択してクリアする感じでOKです。

私自身としては、そのような方法は、あえて避けていました。論理的には、最終行なのですが、実際のExcelの感知は、シート上で、物理的に何もないものは、ナイとしてしまうようです。また、Findメソッドは、VBAから行うと、勝手が悪いので、ミスの可能性をつぶしたつもりでしたが、出来なければ、何を言ったところでしょうがありませんね。

本来は、最終データが、数値なら、ワークシート関数の、Match で探させるという方法が出来る場合があります。文字型の場合は、やむをえないので、vbNullChar という特殊な文字を探すことになるのではないか、と思いました。

たとえば、こんな風にします。

Sub Cells2EmptyR()
Dim i As Variant
　Application.ScreenUpdating = False
　 i = Application.Match(vbNullChar, ActiveSheet.Columns(1), 0)
　If IsError(i) Then
　 i = ActiveSheet.Cells(65536, 1).End(xlUp).Row +1
　End If
　If i > 1 Then
　　ActiveSheet.Rows(i & ":" & 65536).Delete
　 Else
　　MsgBox "1行しか確認できません"
　 End If
　Application.ScreenUpdating = True
End Sub

情報が少ないので、私としては、どなたかが、マクロがヒットすれば、それでよいです。それと、ここで私が思ったのは、元のデータのコピーする時点で、解決する手立てがあると思います。Value2 プロバティに、データが入るから、そのようなことになるわけですから、Value だけをコピーすれば（たぶんVBAのみ）、そのような問題は起こらないはずなのですが。

お礼

問題なくできました。
ありがとうございました。

回答No.6

Wendy02

こんばんは。

>形式を選択して貼り付け（値）したあとは計算式も入っていないので、CSVに変換すればデータは何も入ってないと認識されると思っていたのですが、空白行として認識されます。

本当ですね。私も知りませんでした。
ただ、元のデータのつくりを見せられていないので、どういう並びになっているのか分かりません。本来は、データがわかっていれば、複雑なマクロにはならなくて済むはずです。

最初、A列から、「""」 を探して、その行から、最後の行までを削除することを考えてみました。しかし、それが、データの途中にあったら、次のデータを削除してしまうことになります。また、A列のデータよりも、他の列のデータのほうが、多い場合などを考えてみました。それと、歯抜けになったデータの場合も、考えてあります。データのないシートのエラーも考えました。

結論的には、まだまだ、足りない情報がありますが、上記のようなトラブルのパターンを考えて、以下のコードにしてみました。

'------------------------------------------------------

Sub EndCellsDelete()
　　Dim r As Range
　　Dim i As Long
　　Dim wsh As Worksheet
　　For Each wsh In Worksheets
　　With wsh
　　　　On Error Resume Next
　　　　With .UsedRange
　　　　　　Set r = .Cells(.Cells.Count)
　　　　End With
　　　　If Err.Number = 0 Then
　　　　 i = 0
　　　　 i = .Range("A1").Resize(r.Row + 1).Find("*", .Cells(r.Row, 1).Offset(1), xlValues, 2, 1, 2).Row
　　　　On Error GoTo 0
　　　　Application.ScreenUpdating = False
　　　　If i > 1 And i >= r.Row Then
　　　　　 .Range(.Cells(i + 1, 1), r).Delete
　　　　End If
　　　　Application.ScreenUpdating = True
　　　　End If
　　End With
　　Next wsh
End Sub

-----------------------------------------
なお、実務上は、私は、テキストエディタの正規表現置換で、検索値、「^,+$」で、一回で終えてしまうと思います。

補足

いつもありがとうございます。
試してみましたがうまくいきませんでした。
NO.4さんのコードでうまくいきました。
今回の想定していることは結構単純です。Ａ列が基本になるのでＡ列の最終行より下に他の列に数字が入っていても消してＯＫ。Ａ列が歯抜けになっている可能性は０ではないが、極端な話、単純にＡ列の最終行の一つ下セルからエクセルに一番右下の　IV65536セルまでを選択してクリアする感じでOKです。

回答No.5

ham_kamo

No.1です。すみません、先ほどの回答ですが、コピー＆ペーストに失敗して、
Sub 一括削除()
が
Sub Sub 一括削除()
になってしまっていました。Subは１つだけです。

回答No.3

imogasi

一旦あるセル（質問例では５５０行）でデータが途切れて、またずっと（少し）下行からデータがあり、その部分以下は不要であるということですか。
抹消しなくても、未使用のセル範囲はそのまま置いておいても、不都合は考えられないのですが。
行を非表示（グレイになる）にしたいなら、そういうニーズもあるかと。
あるいはスクロールバーの問題とか＞
マクロの記録モードにして
最後の行まで削除するなら、１つのシートで
Endキーを押して、↓キー
Shiftを押しENDキー後に↓キーを押して、編集ー削除ー上方向にシフトで
VBAのコードを知り
For Each WS In Worksheets　に挟んで少し修正して繰り回せば、よい。

回答No.2

Wendy02

こんばんは。

>Ａ列でデータが入っている一番下のセルがＡ５５０だった場合、５５１行～６５５３６行までを全て選択→削除を行う。

実際は、使っている範囲のみではありませんか（^^;
使っていないところを削除しても無駄ですよね。ちょっと試してみてください。Error トラップは、使っていないシートのためです。

こんばんは。

>Ａ列でデータが入っている一番下のセルがＡ５５０だった場合、５５１行～６５５３６行までを全て選択→削除を行う。

実際は、使っている範囲のみではありませんか？
使っていないところを削除しても無駄ですよね。ちょっと試してみてください。
一応、A列のみの場合は、除外するようにしてあります。

Sub DeleteOverEndOf_A()
Dim ws As Worksheet
For Each ws In Worksheets
With ws
　On Error Resume Next
　If .UsedRange.Cells(.UsedRange.Cells.Count).Column > 1 Then
　.Range(Range("A65536").End(xlUp).Offset(1), .UsedRange.Cells(.UsedRange.Cells.Count)).Delete
　End If
End With
Next
End Sub

補足

ご回答ありがとうございます。
質問の説明が足りなかったようです。
今回処理したい複数のシートは、次の段階でシートごとにCSV形式で保存します。
そして各CSVのファイルを縦に結合し、一つのCSVファイルにします。
実際、一つのCSVファイルにしたら変な空白行がかなりありました。
原因を調べてみました。
元のエクセルデータは１万行くらいまで計算式を入ったデータを、シートの全体を
コピーし、形式を選択して貼り付け（値）をしたものです。
計算式は　例えば=if(●●="","",▲▲）のようなＩＦ文で、条件によっては見た目空白にみえるセルが多く出来るものです。
形式を選択して貼り付け（値）したあとは計算式も入っていないので、CSVに変換すればデータは何も入ってないと認識されると思っていたのですが、空白行として認識されます。
この空白行を消すために今回の質問をしました。
手動での解決策が単純に不要な行を削除することでしたので…
手動で不要な行を削除したあと　→　CSVに変換　→　一つのCSVに結合すれば問題なく出来ます。
お時間があればアドバイスおねがいします。

回答No.1

ham_kamo

こんな感じでしょうか。
標準モジュールにコピーして実行してみてください。

Sub 一括削除()
　Dim WS As Worksheet
　Dim EndRow As Long
　For Each WS In Worksheets
　　With WS
　　　EndRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
　　　.Rows(EndRow & ":" & Rows.Count).Delete
　　End With
　Next
End Sub

補足

ご回答ありがとうございます。
質問の説明が足りなかったようです。
今回処理したい複数のシートは、次の段階でシートごとにCSV形式で保存します。
そして各CSVのファイルを縦に結合し、一つのCSVファイルにします。
実際、一つのCSVファイルにしたら変な空白行がかなりありました。
原因を調べてみました。
元のエクセルデータは１万行くらいまで計算式を入ったデータを、シートの全体を
コピーし、形式を選択して貼り付け（値）をしたものです。
計算式は　例えば=if(●●="","",▲▲）のようなＩＦ文で、条件によっては見た目空白にみえるセルが多く出来るものです。
形式を選択して貼り付け（値）したあとは計算式も入っていないので、CSVに変換すればデータは何も入ってないと認識されると思っていたのですが、空白行として認識されます。
この空白行を消すために今回の質問をしました。
手動での解決策が単純に不要な行を削除することでしたので…
手動で不要な行を削除したあと　→　CSVに変換　→　一つのCSVに結合すれば問題なく出来ます。
お時間があればアドバイスおねがいします。