こんにちは!大阪市住之江区に拠点を置く会社『縁紡ぐ』の稲垣です。
当社は、Excel、ACCESS、RPAなどのシステム開発や既存ツールを使った業務効率化の提案、また、ITスキルアップのための教育に力を入れています。効率的なビジネス運営を目指している企業様、ITスキルの向上を図りたい企業や個人の方に、最適なご提案をさせていただきます。業務プロセスの改善とITスキルアップをサポートし、共に成長するパートナーでありたいと考えています。
【VBA】オブジェクト作成によるパフォーマンス問題の解決方法を調査
反応しなくなる現象とは
Excel VBAを使っていると、大量のデータを処理する際にExcelが一時的に反応しなくなることがあります。どんな症状か具体的に言うと、プログラムが正常終了したのに、そのあと、Excelが応答なしなってしまい、操作ができなくなる現象です。
時間が経つと動くようになったりします。
この現象には、特に、オブジェクトをループ内で繰り返し作成・破棄する場合、この問題が顕著に現れます。本記事では、この問題の原因と解決策について詳しく解説します。
問題の原因
VBAでオブジェクト作成によるパフォーマンス問題は、以下のような原因で発生します。対策を見たい方はすっ飛ばしてください。
オブジェクトの作成と破棄のオーバーヘッド
ループ内でオブジェクトを作成し、また破棄していると、そのたびにメモリ管理のオーバーヘッドが発生します。これがExcelの応答が遅くなる原因になる場合があります。
実際、遅いコードの原因調査でも、ループ内でオブジェクトの生成をしていたパターンでした。
メモリ使用量の増加
大量のオブジェクトを短期間で作成・破棄することで、メモリの使用量が急増し、メモリ管理の負荷が高まります。
ガベージコレクションの遅延
ガベージコレクションとは、プログラミングにおいて不要になったメモリ領域を自動的に回収し、再利用可能な状態にする仕組みです。これにより、メモリの効率的な使用とリソースの管理を行い、プログラムのメモリリーク(メモリが解放されずに無駄に消費され続ける状態)を防ぐことができます。
VBAのガベージコレクションは即時に行われるわけではなく、オブジェクトの解放に時間がかかることがあります。これがExcelのパフォーマンスに影響を与えることがあります。
実際のコード例とその改善
問題となるコードの例と、その改善方法をご紹介します。
問題となるコード
Option Explicit
Public Property Get getUsers() As Collection
Dim users As Collection
Set users = New Collection
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("UserSheet")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim userArray As Variant
userArray = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 2))
Dim i As Long
Dim tmpUser As User
For i = 2 To lastRow
Set tmpUser = New User ’👈ここのインスタンスの生成が問題
tmpUser.init userArray(i, 1), userArray(i, 2)
users.Add tmpUser
Set tmpUser = Nothing
Next
Set getUsers = users
End Property
このコードでは、For
ループ内で毎回新しいUser
オブジェクトを作成しています。これがパフォーマンス問題の原因となります。
プログラム自体は、50万行処理するのは2秒ちょっとで終了しますが、正常終了後、Excelが10秒以上反応しなくなります
ObjPtr関数でオブジェクトのメモリ番地を出力してみます。
イミディエイトウインドウに表示されている、メモリの番地がすべて異なっているのがわかると思います。
同じオブジェクトでやってみる
同じオブジェクトを再利用してみます。
これは、同じメモリを参照するので解決はしないと思いながらやっています。実際解決しませんでした(笑)
Option Explicit
Public Property Get getUsers() As Collection
Dim users As Collection
Set users = New Collection
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("UserSheet")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim userArray As Variant
userArray = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 2))
Dim i As Long
Dim tmpUser As User
Set tmpUser = New User '👈forの外でインスタンスを生成しておく
For i = 2 To lastRow
'Set tmpUser = New User 👈ここのインスタンスの生成が問題なのでやめる
tmpUser.init userArray(i, 1), userArray(i, 2)
users.Add tmpUser
'Set tmpUser = Nothing 👈インスタンスを破棄すると再利用できないのでやめる
Next
Set tmpUser = Nothing
Set getUsers = users
End Property
ObjPtr関数でオブジェクトのメモリ番地を出力してみます。
同じメモリのアドレスが使用されています。
この改善されたコードでは、tmpUserオブジェクトをループ外で一度だけ作成し、ループ内ではそのプロパティを設定するだけにしています。これにより、オブジェクトの作成・破棄のオーバーヘッドが削減され、メモリ管理の負荷が軽減されます。が、問題解決には何もなっていないというか、同じインスタンスをすべて参照するので、意味がありませんね💦
Collectionには、同じメモリを参照するようになってしまい、Collectionに追加されているオブジェクトは、すべて同じものになってしまいます
DoEventsを定期的に追加
DoEventsとは、現在実行中のマクロを一時的に中断し、他のシステムイベント(例えば、ユーザーの操作や他のアプリケーションからの要求)を処理するための時間を与えるものです。
Option Explicit
Public Property Get getUsers() As Collection
Dim users As Collection
Set users = New Collection
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("UserSheet")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim userArray As Variant
userArray = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 2))
Dim i As Long
Dim tmpUser As User
Dim batchSize As Long
batchSize = 100 '100回毎
For i = 2 To lastRow
Set tmpUser = New User
tmpUser.init userArray(i, 1), userArray(i, 2)
users.Add tmpUser
Set tmpUser = Nothing
' バッチ処理の一部として定期的にDoEventsを呼び出す
If i Mod batchSize = 0 Then
DoEvents
End If
Next
Set tmpUser = Nothing
Set getUsers = users
End Property
解決したり解決しなかったりします(調査したかったのですが、すでに時間がすごくかかっていたので断念)
メモリ解放用のプロシージャを作成
メモリ解放用のプロシージャを作成し、DoEvents後に実行してみます。
' Windows APIの宣言
Private Declare PtrSafe Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Declare PtrSafe Function GlobalCompact Lib "kernel32" (ByVal dwMinFree As Long) As Long
' メモリのステータスを格納するための構造体
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
' メモリ解放を実行するサブプロシージャ
Private Sub FreeMemory()
Dim MemStat As MEMORYSTATUS
MemStat.dwLength = Len(MemStat)
GlobalMemoryStatus MemStat
GlobalCompact 0
End Sub
こちらのコードでは、Excelがクラッシュしてしまいダメでした。
メッセージボックスを表示してExcelを強制終了させない
これが今のところ一番の解決策でした…
MsgBox "処理が重いためExcelがしばらく応答しませんが、強制終了しないでください"
まとめ
Excel VBAでのオブジェクト作成によるパフォーマンス問題は、繰り返し処理の中で何度もオブジェクトを生成すると起こります。
もし、プログラムが正常終了したのにExcelが反応しなくなる場合は、ぜひ、参考にしてみてくださいね!
稲垣
- Excel、ACCESSでのシステム開発が得意
- ITスキルを共有し実践的に学びながら成長する人を見るのが幸せ
- 自家焙煎するほどのコーヒー好き
- 使用言語 VBA、Python、Javascript、Java、HTML、CSS etc.
- 保有資格 Kintoneアソシエイト、日商簿記検定2級、マンション管理士、管理業務主任者、情報セキュリティマネジメント、ExcelVBA etc.
- 業務フロー図の作成や業務時間分析を通して、効率化ポイントを探る人
- お客様にとって本当に良いことかを第一に考える人
コメント