今、Excelのシートが複数(この場合は3つ)あるとします。
「果物シート」には、この図 http://www.fastpic.jp/images/403/7360443948.jpg のように、データが入っています。
しかし、縦列にずーっと下がっていくと、55260行目辺りにもいくつかデータがあり。http://www.fastpic.jp/images/091/9149705633.jpg
横列もずーっと見ていくと、DY~EB列にもデータが点在しています。http://www.fastpic.jp/images/815/4551680644.jpg
この際、縦軸(列)において、一番最後にデータが入ってるセルより下の行以降を全て選択して削除し。(イメージ:http://www.fastpic.jp/images/791/2139172297.jpg )
同じく横軸(業)においても、一番最後にデータが入ってるセルより右の列以降を全て選択して削除する。(イメージ:http://www.fastpic.jp/images/391/1199532087.jpg )
そして同じようなデータ削除を全てのシートに適用する。
(※この場合は「果物2」「果物3」シートのみになりますが、シートが数十枚に及ぶことがあるので、可能であればシート名に関係なく全シートに処理を施したいです。)
そのような処理を行うマクロを、もしご存知でしたら教えていただきたい次第です。
よろしくお願いします。
通常であれば下記で出来ると思いますが、
Option Explicit Sub DeleteEmptyAreaSimple() Dim ws As Worksheet Dim lastRow As Long Dim lastCol As Long For Each ws In Worksheets With ws lastRow = ws.UsedRange.Rows.Count lastCol = ws.UsedRange.Columns.Count If lastCol < Columns.Count Then .Range(.Cells(1, lastCol + 1), .Cells(1, Columns.Count)).EntireColumn.Delete End If If lastRow < Rows.Count Then .Range(.Cells(lastRow + 1, "A"), .Cells(Rows.Count, "A")).EntireRow.Delete End If End With Next End Sub
シートがデータのない範囲まで、使用している範囲と認識していることも有るので、
実際のデータを確認して範囲を削除する例です。
Option Explicit Sub DeleteEmptyArea() Dim ws As Worksheet For Each ws In Worksheets cleanupWS ws Next End Sub Sub cleanupWS(ws As Worksheet) Dim lastRow As Long Dim maxLastRow As Long Dim maxLastCol As Long With ws maxLastRow = .Cells(Rows.Count, "A").End(xlUp).Row maxLastCol = 1 Dim c As Long For c = 2 To Columns.Count If Application.WorksheetFunction.CountA(.Columns(c)) <> 0 Then maxLastCol = c lastRow = .Cells(Rows.Count, c).End(xlUp).Row If lastRow > maxLastRow Then maxLastRow = lastRow Next If maxLastCol < Columns.Count Then .Range(.Cells(1, maxLastCol + 1), .Cells(1, Columns.Count)).EntireColumn.Delete End If If maxLastRow < Rows.Count Then .Range(.Cells(maxLastRow + 1, "A"), .Cells(Rows.Count, "A")).EntireRow.Delete End If End With End Sub
うまく削除できました!
2012/03/24 06:45:02ありがとうございます(^_^;)
無事にできたようでよかったです。
2012/03/24 18:17:12