【Excel365マクロ】時間短縮方法

質問

下記は「行9～170のH列が空白ならば非表示にする」というマクロです。

----------------------
Sub 空白行非表示()

Sheets("シート1").Select

Application.ScreenUpdating = False
For rw = 9 To 170
If Range("H" & rw) = "" Then
Rows(rw).EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
Columns("E:E").EntireColumn.Hidden = True

Range("B2").Select

End Sub
----------------------

同様のマクロを多用していますが、行数が多いファイルは開始数秒後に「応答なし」が表示され、終わるのに1分近く時間がかかることが多く困っております。
行数が10行程度のファイルは数秒～10数秒程度で終わることもありますが、同じく1分近くかかることもあります。

上記マクロ以外に数秒で終わるマクロはありませんか？
フィルターの使用は無しでお願いします。

回答No.12

SI299792 · ベストアンサー

＞セル番地(行数や列位置)は異なり
であれば、これでどうでしょうか。シート名、セル位置は変更して下さい。
Option Explicit
'
Sub Macro()
'
　　BrankHidden [シート1!H9:H170]
　　BrankHidden [シート2!H9:H170]
　　BrankHidden [シート3!H9:H170]
End Sub
'
Sub BrankHidden(IRange As Range)
　　Dim Cell As Range
　　Dim Area As Range
'
　　For Each Cell In IRange
'
　　　　If Cell > "" Then
　　　　ElseIf Area Is Nothing Then
　　　　　　Set Area = Cell
　　　　Else
　　　　　　Set Area = Union(Area, Cell)
　　　　End If
　　Next Cell
　　Area.EntireRow.Hidden = True
End Sub

お礼

何度もご回答ありがとうございました。

ご教示いただいたマクロをまるまるコピペしてsheet名とセル番地を変更して実行してみましたが、1行目のBrankHidden～部分で「実行時エラー'424':　オブジェクトが必要です。」というエラーが出てしまいました。
”実行時エラー424”をググってみたところ「”Set”が必要」との記載でしたが、よくわかりません・・・

回答No.13

SI299792

こちらでは正しく動いています。
https://1drv.ms/x/s!AnfEM367OeSdixsv0xehNl4yWDZV?e=3bamdY
実行時エラー'424'
シートが存在しなければこのエラーが出ます。シート名を確認して下さい。

もう１つの可能性は、Microsoft365はシート名に''が付くみたい照す。
　　BrankHidden ['シート1'!H9:H170]
の様にシート名を''で囲んでみて下さい。

お礼

何度もご回答ありがとうございました。

・・・1～2秒で終わりました。感激で涙出そうです。
今までの待ち時間が何だったのか・・・

同じようなファイルが20個以上あるので、すべてこのマクロへ差し替えます!!
大変助かりました。

長々とお付き合いいただき、ありがとうございました。
今後とも、よろしくお願い致します。

回答No.11

kkkkkm

> 「メモリ不足～」というエラーが出て全12sheetのうち5sheetの途中で止まってしまいました。

こちらに丁度12シートあるブックがあったので、そこにA1:AC170にデータと少しだけVLOOKUPを入れて数回テストした時にはエラーもなく終わったのですが、何かしら不具合があったのかもしれません。業務に支障が出たとのことで申し訳ないです。

お礼

何度もご回答ありがとうございました。

いえいえ、こちらこそご面倒をお掛けして申し訳ありません。
当方の無茶ぶりな質問に丁寧にご回答いただき、大変感謝しております。

回答No.10

SI299792

10秒は、時間かかりすぎ、何か問題あると思います。

私は超能力者ではありません。あなたがどのように直したか判らないので、どこが悪いか判りません。

３つのシートとは❓
・全てのシートが対象なのか
・左から３つが対象なのか
・シート名が決まっているのか。

Macro2は試していないのでしょうか。
フィルターがかかっていない状態で非表示になりますが。

お礼

何度もご回答ありがとうございました。

「3つのシートとは」
質問に書いたコードを3つつなげています。
セル番地(行数や列位置)は異なり、sheetの位置はバラバラです。
同時に、sheetの非表示(Worksheets("シート6").Visible = False　など)も実行しています。

Macro2についてですが、10秒以内に終わることができました。
上記に書いた通り、同じ処理を他の2sheetでも実行していますので、このマクロを他の2sheetにも設定すればもっと早くなるかと思います。
ただ、元々B8：AC8にフィルタが設定されておりましたが、それを消されてしまいましたので止めました。マクロで再度設定すればいいだけの話ですが。

回答No.9

kkkkkm

WindowsUpdateの期間ですがバックでディスクアクセスしてないでしょうか

お礼

何度もご回答ありがとうございました。

WindowsUpdateは社内独自システムで実行するようになっていますので、自動的には実行されません。

回答No.8

kkkkkm

> 結果・・・むしろ遅くなりました、なぜ？

バックグラウンドで何か動いてはないでしょうか。
あと、オフィスの修復とかでしょうか。
あ、昔からなんですね、としたら修復は関係ないようですね。

ちなみにブックの新規へのコピーですが
数式タブで数式の表示にしてコピーして
貼り付けるときに
「Office クリップボード」を開いてから貼り付けるとVLOOKUP等の計算式も元のままで貼り付けられます。

ただし、上記だけだと幅と高さや書式は受け継ぎませんから

数式タブで数式の表示
行で選択してコピー
ホームタブの貼り付けの下の▼をクリックして元の列幅を保持
で貼り付けると行と幅が保持されますので、その後Office クリップボードで貼り付けすると早いと思います。

マクロでやると(時間はかかるかもしれません)

現在のブックのマクロとして実行してください。
名前の定義、全てのシートのシート名、A1:AC170の表示形式、行列幅、計算式ともに転記します。
Book1.xlsxは新しく作るブック名にしてください。
シートは新しく作りませんんので実行前に現在のブック数に合わせて(より多ければ可です)おいてください。

Sub Test()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws As Worksheet
Dim mName As Name
Dim i As Long, j As Long, wsNo As Long

Application.ScreenUpdating = False

Set Wb1 = ThisWorkbook
Set Wb2 = Workbooks("Book1.xlsx")

wsNo = 1

For Each Ws In Wb1.Worksheets
Wb2.Sheets(wsNo).Name = Ws.Name
With Wb2.Sheets(Ws.Name)
Ws.Range("A1:AC170").Copy
.Range("A1:AC170").PasteSpecial
.Range("A:AC").PasteSpecial xlPasteColumnWidths
For j = 1 To 170
.Rows(j).RowHeight = _
Ws.Rows(j).RowHeight
Next j
.Range("A1:AC170").Formula = Ws.Range("A1:AC170").Formula
wsNo = wsNo + 1
End With
Next

For Each mName In Wb1.Names
Wb2.Names.Add Name:=mName.Name, RefersTo:=mName.RefersToR1C1
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

お礼

何度もご回答ありがとうございました。

Office クリップボードの存在は存じていましたが、そのような便利機能があったのですね。
おっしゃるように行列幅そのまま、数式も元ファイルのリンク無しに貼り付けできました。
ただ、書式(フォントなど)が元データとは異なるsheetもあり、個別に手直しが必要でした。

マクロも試してみました。
他のsheetで300行程度のデータがあるため、170を310に変更しました。
途中ファイルを開くような画面が出ましたがキャンセルしてそのまま進めましたが、「メモリ不足～」というエラーが出て全12sheetのうち5sheetの途中で止まってしまいました。
やはりこのファイルは問題ありかも知れません。

ちなみに、PC仕様は以下の通りです。
　・OS：Win10 Pro 64bit 21H2
　・記憶媒体：SSD 256GB
　・メモリ：8GB
　・CPU：Intel Core i5-8250U

マクロを繰り返し実行しすぎたせいか、Office全体が不安定になってしまい、通常業務にも支障が出てしまいました。
※PC再起動で正常に戻りました

回答No.7

SI299792

今思いついたのですが、シート全体をコピー、磔のオプション、値にして、関数を無くして実行してみて下さい。それで早くなれば数式が原因。それでも遅いならオンライン版が原因です。

お礼

再度のご回答ありがとうございました。

情報不足で申し訳ありません。
365へ変更になる前(2010と2013)からずっと動きが遅いのです。

回答No.6

SI299792

私も試したら、一瞬でできました。但し、オフライン版です（365 は無料版を使っているのでマクロが使えません）。数式が原因なら、
　　Application.Calculation = xlManual
で早くなるはずです。それでも遅いなら、オンライン版で、１ステップ毎にホストとデータをやり取りしているから遅い、意外考えられません（だとしたら、オンラインマクロは役に立たなくなってしまいます）
ループを使わない方法を考えました。

Macro1：完全空白のみ対象です。関数で空白にしている場合は非表示なりません。
Macro2：プログラムの途中でオートフィルターを使っています。オートフィルターを解除してから非表示にしているのでオートフィルターは残りません。
Macro3：ループを使っていますが、Hiddenは一回だけ。ひょっとしたら早くなるかもしれません。結果を補足して下さい。
Option Explicit
'
Sub Macro1()
'
　　[H9:H170].SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End Sub
'
Sub Macro2()
　　Dim Area As Range
'
　　ActiveSheet.AutoFilterMode = False
　　[H8:H170].AutoFilter 1, ""
　　Set Area = [H9:H170].SpecialCells(xlCellTypeVisible)
　　ActiveSheet.AutoFilterMode = False
　　Area.EntireRow.Hidden = True
End Sub
'
Sub Macro3()
　　Dim Cell As Range
　　Dim Area As Range
'
　　For Each Cell In [H9:H170]
'
　　　　If Cell > "" Then
　　　　ElseIf Area Is Nothing Then
　　　　　　Set Area = Cell
　　　　Else
　　　　　　Set Area = Union(Area, Cell)
　　　　End If
　　Next Cell
　　Area.EntireRow.Hidden = True
End Sub

お礼

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

Macro3でテストさせていただきました。
「応答なし」が出ることなく10秒以内で終わりました。

同じ処理を2つのsheetでも実行しているため、その2つのsheetも同じコードへ変更したら「同じ適用範囲内で宣言が重複しています」というコンパイルエラーが出ました。
1つ目のsheetだけこのコードにしたら、将来の担当者が「同じ処理なのにコードは違うのはなぜ？」と混乱すると思います。

3sheet同じコードにすることはできませんか？

補足

新規にファイルを作り直し、ご教示いただいたMacro3を貼り付けました。

結果・・・むしろ遅くなりました、なぜ？

回答No.5

kkkkkm

> 1回のマクロで数式びっしりの3つのsheetを処理しているので、そのせいですかね？

Application.Calculation で自動計算をオフにしてもそれほど変わらないのでしたら計算式のせいでという事もないと思います。

最初考えたのは、同じ行数でも早かったり遅かったりという事でしたので
Worksheet_SelectionChangeがあり、実行時にB2以外を選択していて、Range("B2").Selectの時点でイベントが発生して(B2選択していたら発生しない)SelectionChangeが条件によって何か時間のかかる動作をしてるのかなと思ったのですが
Application.EnableEvents = False
を入れても同じでしたら、それも違うみたいですね。

3つのsheetを処理というのは質問のコードと実際のコードが違うという事でしょうか。

コードが質問のコードの状態でしたら、テストでシートの必要な部分を新しいブックにコピペして(シートのコピーではなく)試してみて早くなるようでしたら、ブックもしくはシートの破損が考えられます。

お礼

何度もご回答ありがとうございました。

>3つのsheetを処理というのは質問のコードと実際のコードが違うという事でしょうか
セル番地が違うだけでコードはまったく同じです。同時にsheetの非表示など、他のコードも含まれています。

>ブックもしくはシートの破損が考えられます
なるほど、ありえますね。
10数年前に作られたファイルを歴代の担当者によって都度改造されてますので、可能性はあります。

新規に作り直すとなると、10数個あるsheetをコピペ＆数式の設定し直しには相当な時間がかかります。

補足

新規にファイルを作り直しました。
行列の幅を設定し直すのが変動なのでシート全体を選択＆コピペ、数式は置き換えでコピー元のファイル名を消し、名前の管理でエラーになっているものは全部消しました。
ファイルサイズは若干小さくなりました。

結果・・・むしろ遅くなりました、なぜ？

回答No.4

imogasi

私もやって見ましたが、一瞬で終わりました。
VBAコードの書き方というよりは、他の原因を当たった方がよいのでは。
ただしこの原因追求は難物と予想するが。
バージョンの３６５も関係ないと、思います。
ーー
やって見たコード
Sub test01()
Columns("E:E").EntireColumn.Hidden = True
End Sub
ーー
Sub test02()
Application.ScreenUpdating = False
For rw = 9 To 170
If Range("H" & rw) = "" Then
Rows(rw).EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub
本件ではないが、行ごと繰り返し法でなく、Ｒａｎｇｅに直接設定できる表示形式設定などは、Ｒａｎｇｅ（・・）.設定＝xxのような形式の方が良い（処理が早い）と思う。
ーーー
Sub test04()
Range("H9:H170").Select
Selection.AutoFilter field:=1, Criteria1:=""
End Sub
などやって見た。
この程度のデータ量では、１瞬にして終わりました。

お礼

テスト及びご回答ありがとうございました。

皆さん一瞬で終わるのですね。
やはり数式が原因でしょうか・・・

回答No.3

kkkkkm

No.1の追加です。

書き忘れてました。

Application.ScreenUpdating = True
Columns("E:E").EntireColumn.Hidden = True

Range("B2").Select

これはScreenUpdatingが最後の方がいいのではないでしょうか

お礼

再度のご回答ありがとうございました。