ExcelVBAで、広範囲セルの空白チェックをしたいと思います。

質問

ExcelVBAで、広範囲セルの空白チェックをしたいと思います。

以下のようなExcelシートがあります。
・10行目まではタイトル行
・データ入力可能セル範囲はA11～AF65536

全てのデータ範囲を削除するために、以下のコードを作成しました。
動きとしては問題ないのですが、データが存在しない場合の
処理時間が長くなってしまいます。

Sub 全データ削除()

Dim endrow As Long
Dim mydelete As Integer
Dim myrange As Range

endrow = Range("A11").End(xlDown).Row
For Each myrange In Range("A11:AF" & endrow)
If myrange.Value <> "" Then
GoTo 削除処理
End If
Next myrange

MsgBox "データがありません。"
Exit Sub

削除処理:
mydelete = MsgBox("全てのデータを削除しますか？", vbOKCancel)
Select Case mydelete
Case vbOK
Rows("11:65536").Delete
Range("D4").Formula = "=COUNTA(A11:A65536)"
MsgBox "データを削除しました。"
Exit Sub
Case vbCancel
MsgBox "キャンセルされました。"
Exit Sub
End Select

End Sub

データ範囲が65536行までになってしまうため時間がかかっているのだと思いますが、
回避方法がわかりません。

ご教授お願いいたします。

回答No.4

Wendy02 · ベストアンサー

>二度目以降は、myRangeの行選択が前回までの最大行数を
>引き継いでいるようです。

何か、情報が不足しているようです。
少し説明しながら書きます。考えてみてください。

修正：
　Set myRange = Intersect(ActiveSheet.UsedRange, Range("A11:A" & EndRow).EntireRow)
　　　　　　　　　　↓
　Set myRange = Range("A11:A" & EndRow).EntireRow　'当面はこれでやってみてください。

「UsedRange と Range("A11:A" & EndRow)の行全体までで重なる部分を削除しろ。」という命令ですが、実際、こちら側では、UsedRangeの範囲がはっきりみえていません。たぶん、その通常書き込むデータ範囲以外のところに文字や数字などのデータがあると思います。

一度、Ctrl + Shift + End(データが存在したという痕跡も含む） または、ActiveSheet.UsedRange.Selectで、最終データ位置を確認したほうがよいです。もし、不要なら、それらの文字や情報などは削除したほうがよいと思います。ファイルの肥大化の原因になります。そうでなければ、修正したほうをお使いください。

もう少し専門的な説明をさせていただきますが、

　　Rows("11:65536").Delete
このコマンドを使わないのは、Excelというのは、最大行が、65536行(Excel2003まで）あるとすると、データのある範囲までは、ファイルが存在するということです。それ以降は理論行・理論列で実際には存在しません。実際は、最終行・最終列の四角の範囲がファイルのサイズになります。マクロの時は、必ず、最終行・最終列まで行きますが、存在していない所でも、論理的な処理をしてしまいます。

なお、この数式ですが、
>　Range("D4").Formula = "=COUNTA(A11:A65536)"

=COUNTA(INDIRECT("A11:A65536"))　'ただし、再計算関数になってしまいます。
[Range("D4").Formula = "=COUNTA(INDIRECT(""A11:A65536""))"]
　　または、
=COUNTA(A10:A65536)-1

これはたぶん、削除した時に、エラーになってしまうからですね。
本当は、INDIRECT 関数を用いるか、先頭行を一つ手前にして、-1 にすれば、書き加えずに済みます。

お礼

ご親切にありがとうございます。
大変丁寧に解説いただいたので、理解できました。
Ctrl + Shift + Endで調べたら、データの痕跡があったようです。

>　Range("D4").Formula = "=COUNTA(A11:A65536)"
この数式についても、苦肉の策でしたが、
ちゃんと回避方法があったんですね。
=COUNTA(A10:A65536)-1
を利用させていただきます。

どうもありがとうございました。

回答No.3

Wendy02

だいぶ、VBAのコーディングは書きなれているようにお見受けしています。しかし、ご質問のコードは、独特の癖があるようです。たぶん、製作の手順に問題があるようです。メインにするのは、Delete の部分ですから、そこを中心にして必要な部分を付け足すようにしたほうがよいですね。

Goto の良し悪しについては、金科玉条で文句をつける人がいますが、それについては指摘しません。ただ、もし使うなら、なるべくサブルーチンにしたほうがよいかもしれません。Goto は、エラーが発生した時にしたほうがきれいです。

以下の私のコードは、決してほめられたコードとは言えません。詰め込みすぎて、息苦しい気もします。必ずしも、そうするべきものではもありません。

32 + vbOKCancel　の32は、実際は組み込み定数でよいです。長くなるので省いただけです。

EndRow = Cells(Rows.Count, 1).End(xlUp).Row
EndRow2 = Cells(11, 1).End(xlDown).Row
下側に向かって探す方法ですと、65536まで探します。
最後から上側に向かって探す方法だと、データの最後尾を探します。
どちらにも欠点があります。それを補うために、
　If EndRow2 > EndRow Then EndRow = EndRow2
で、補完させました。フルにいれなければ、こんな問題は発生しませんが、
　Rows("11:65536").Delete
こういうコードから根拠にました。

　Intersect(ActiveSheet.UsedRange, Range("A11:A" & EndRow).EntireRow)
UsedRange と、重なる部分のみを削除するということにしました。

Range("A11:A" & EndRow).EntireRow.Delete
だけでもよいはずですが、削除に必要な最小限の範囲にするためにIntersect を使いました。

変数は、キャメル(らくだ）型にすると、小文字で入力すると、変化しますから、入力ミスが分かります。

'//
Sub 全データ削除r1()
　Dim EndRow As Long　'変数はキャメル型が良いです。
　Dim EndRow2 As Long
　Dim myDelete As Integer
　Dim myRange As Range

　EndRow = Cells(Rows.Count, 1).End(xlUp).Row
　EndRow2 = Cells(11, 1).End(xlDown).Row
　If EndRow2 > EndRow Then EndRow = EndRow2
　Set myRange = Intersect(ActiveSheet.UsedRange, Range("A11:A" & EndRow).EntireRow)
　If Not myRange Is Nothing Then
　　myRange.Select
　　If MsgBox("全てのデータを削除しますか？", 32 + vbOKCancel) = vbCancel Then
　　　MsgBox "キャンセルされました", vbInformation
　　　Exit Sub
　　Else
　　　Application.ScreenUpdating = False
　　　myRange.Delete
　　　Application.ScreenUpdating = True
　　　Range("D4").Formula = "=COUNTA(A11:A65536)"
　　　MsgBox "データを削除しました。", 64
　　End If
　Else
　　MsgBox "データがありません。"
　End If
End Sub

補足

回答ありがとうございます。
すばらしいですね。
EndRowとEndRow2の２つを使う方法は、目からウロコでした！
瞬時に処理ができましたし、理想の動きでした。
かなり勉強になりました。

ただ、成功したのは一番最初だけでした。
二度目以降は、myRangeの行選択が前回までの最大行数を
引き継いでいるようです。
Excelを一度保存し、再起動しても、この部分は引き継いでいました。

コードの最後に、Set myRange = Nothing を付け加えてみましたが、
結果は同じでした。

あれこれ試行錯誤してみましたが、解決しません。。。
度々申し訳ありません。

回答No.2

o_chi_chi

検索を使えばよいのでは？
ループで回せば１件づつの削除も可能です。

---
With Worksheets(1).Range("a11:AF65536")
Set c = .Find("*", LookIn:=xlValues)
If Not c Is Nothing Then
call 削除処理
End If
End With

お礼

回答ありがとうございます。
ご教授いただいた方法でも、結果は同じでした。

回答No.1

mu2011

データ入力がない場合、空白チェックをA11：AF65536まで繰り返すからです。
何故、空白チェックが必要なのか不明、単純に削除処理だけのコードでよいと思いますが駄目なのでしょうか。

お礼

回答ありがとうございます。
ユーザーにとっての使いやすさを考慮すると、
データの存在チェックは必要不可欠だと考えています。