excel-vba
Excel-VBAの最適化
サーチ…
前書き
Excel-VBAの最適化は、ドキュメントと追加の詳細によるエラー処理のコーディングにも使用されます。これをここに示します。
備考
*)行番号は整数で、-32,768〜32,767の範囲の符号付き16ビットデータ型です。そうでないと、オーバーフローが発生します。通常、行番号は、コードの一部またはモジュール全体のすべてのプロシージャに10のステップで挿入されます。
ワークシートの更新を無効にする
ワークシートの計算を無効にすると、マクロの実行時間が大幅に短縮されます。さらに、イベント、画面更新、ページ区切りを無効にすることは有益です。後続のSub
は、この目的のためにどのマクロでも使用できます。
Sub OptimizeVBA(isOn As Boolean)
Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
Application.EnableEvents = Not(isOn)
Application.ScreenUpdating = Not(isOn)
ActiveSheet.DisplayPageBreaks = Not(isOn)
End Sub
最適化のために以下の擬似コードに従ってください:
Sub MyCode()
OptimizeVBA True
'Your code goes here
OptimizeVBA False
End Sub
実行時間の確認
異なる手順でも同じ結果が得られますが、異なる処理時間が使用されます。どちらが速いかを調べるために、次のようなコードを使うことができます:
time1 = Timer
For Each iCell In MyRange
iCell = "text"
Next iCell
time2 = Timer
For i = 1 To 30
MyRange.Cells(i) = "text"
Next i
time3 = Timer
debug.print "Proc1 time: " & cStr(time2-time1)
debug.print "Proc2 time: " & cStr(time3-time2)
Private Declare PtrSafe Function getFrequency Lib "Kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "Kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Function MicroTimer() As Double
Dim cyTicks1 As Currency
Static cyFrequency As Currency
MicroTimer = 0
If cyFrequency = 0 Then getFrequency cyFrequency 'Get frequency
getTickCount cyTicks1 'Get ticks
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency 'Returns Seconds
End Function
Withブロックの使用
ブロックを使用すると、マクロを実行する処理が高速化されます。範囲、チャート名、ワークシートなどを書く代わりに、以下のようなwith-blocksを使うことができます。
With ActiveChart
.Parent.Width = 400
.Parent.Height = 145
.Parent.Top = 77.5 + 165 * step - replacer * 15
.Parent.Left = 5
End With
これはこれよりも速い:
ActiveChart.Parent.Width = 400
ActiveChart.Parent.Height = 145
ActiveChart.Parent.Top = 77.5 + 165 * step - replacer * 15
ActiveChart.Parent.Left = 5
ノート:
Withブロックが入力されると、オブジェクトは変更できません。その結果、1つのWith文を使用して複数の異なるオブジェクトに影響を与えることはできません
Withブロックの内外にジャンプしないでください 。 Withブロック内のステートメントが実行され、WithステートメントまたはEnd Withステートメントが実行されない場合、プロシージャーを終了するまで、オブジェクトへの参照を含む一時変数はメモリー内に残ります
特にWithキャッシュされたオブジェクトがイテレータとして使用されている場合、With文をWithループしないでください。
With文を別のブロック内に配置することで、With文をネストすることができます。ただし、Out WithブロックのメンバーはWith Withブロック内でマスクされるため、In Withブロックの完全修飾オブジェクト参照をOut Withブロックのオブジェクトの任意のメンバーに提供する必要があります。
入れ子の例:
この例では、Withステートメントを使用して、単一のオブジェクトに対して一連のステートメントを実行します。
オブジェクトとそのプロパティは、説明目的でのみ使用される総称名です。
With MyObject
.Height = 100 'Same as MyObject.Height = 100.
.Caption = "Hello World" 'Same as MyObject.Caption = "Hello World".
With .Font
.Color = Red 'Same as MyObject.Font.Color = Red.
.Bold = True 'Same as MyObject.Font.Bold = True.
MyObject.Height = 200 'Inner-most With refers to MyObject.Font (must be qualified
End With
End With
MSDNの詳細情報
行の削除 - パフォーマンス
行を削除するのが遅く、特にセルをループしたり、行を1つずつ削除するとき
別の方法として、オートフィルタを使用して削除する行を非表示にする方法があります
可視範囲をコピーして新しいワークシートに貼り付けます
最初のシートを完全に取り除く
このメソッドを使用すると、削除する行が多いほど速くなります
例:
Option Explicit
'Deleted rows: 775,153, Total Rows: 1,000,009, Duration: 1.87 sec
Public Sub DeleteRows()
Dim oldWs As Worksheet, newWs As Worksheet, wsName As String, ur As Range
Set oldWs = ThisWorkbook.ActiveSheet
wsName = oldWs.Name
Set ur = oldWs.Range("F2", oldWs.Cells(oldWs.Rows.Count, "F").End(xlUp))
Application.ScreenUpdating = False
Set newWs = Sheets.Add(After:=oldWs) 'Create a new WorkSheet
With ur 'Copy visible range after Autofilter (modify Criteria1 and 2 accordingly)
.AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd, Criteria2:="<>"
oldWs.UsedRange.Copy
End With
'Paste all visible data into the new WorkSheet (values and formats)
With newWs.Range(oldWs.UsedRange.Cells(1).Address)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteAll
newWs.Cells(1, 1).Select: newWs.Cells(1, 1).Copy
End With
With Application
.CutCopyMode = False
.DisplayAlerts = False
oldWs.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
newWs.Name = wsName
End Sub
すべてのExcel機能を無効にする大規模マクロを実行する前に
以下の手順では、WorkBookおよびWorkSheetレベルですべてのExcel機能を一時的に無効にします
FastWB()は、OnまたはOffフラグを受け付けるトグルです
FastWS()は、オプションのワークシートオブジェクトを受け入れるか、または何も受け付けません
wsパラメータが指定されていない場合は、コレクション内のすべてのワークシートのすべての機能をオンまたはオフにします
- カスタムタイプを使用してすべての設定をキャプチャしてからオフにすることができます
- プロセスの最後に、初期設定を復元することができます
Public Sub FastWB(Optional ByVal opt As Boolean = True)
With Application
.Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
If .DisplayAlerts <> Not opt Then .DisplayAlerts = Not opt
If .DisplayStatusBar <> Not opt Then .DisplayStatusBar = Not opt
If .EnableAnimations <> Not opt Then .EnableAnimations = Not opt
If .EnableEvents <> Not opt Then .EnableEvents = Not opt
If .ScreenUpdating <> Not opt Then .ScreenUpdating = Not opt
End With
FastWS , opt
End Sub
Public Sub FastWS(Optional ByVal ws As Worksheet, Optional ByVal opt As Boolean = True)
If ws Is Nothing Then
For Each ws In Application.ThisWorkbook.Sheets
OptimiseWS ws, opt
Next
Else
OptimiseWS ws, opt
End If
End Sub
Private Sub OptimiseWS(ByVal ws As Worksheet, ByVal opt As Boolean)
With ws
.DisplayPageBreaks = False
.EnableCalculation = Not opt
.EnableFormatConditionsCalculation = Not opt
.EnablePivotTable = Not opt
End With
End Sub
すべてのExcel設定をデフォルトに戻す
Public Sub XlResetSettings() 'default Excel settings
With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.DisplayStatusBar = True
.EnableAnimations = False
.EnableEvents = True
.ScreenUpdating = True
Dim sh As Worksheet
For Each sh In Application.ThisWorkbook.Sheets
With sh
.DisplayPageBreaks = False
.EnableCalculation = True
.EnableFormatConditionsCalculation = True
.EnablePivotTable = True
End With
Next
End With
End Sub
拡張デバッグによるエラー検索の最適化
行番号を使用して...エラーの場合に文書化する (「Erlを見ることの重要性」)
どのラインがエラーを発生させるかを検出することは、デバッグの実質的な部分であり、原因の探索を狭める。識別されたエラー行を簡単な説明で文書化するには、モジュールとプロシージャーの名前とともに、エラー追跡を成功させる必要があります。以下の例では、これらのデータをログファイルに保存しています。
バックグラウンド
エラーオブジェクトはエラー番号(Err.Number)とエラー記述(Err.Description)を返しますが、エラーの場所を明示的には問いません。 Erlの機能は、しかし、ありませんが、あなたは、コード(旧基本倍に、他のいくつかの譲歩のBTW 1)に)*行番号を追加することを条件に。
エラー行がまったくない場合、Erl関数は0を返します。番号が不完全な場合は、プロシージャの直前の行番号を取得します。
Option Explicit
Public Sub MyProc1()
Dim i As Integer
Dim j As Integer
On Error GoTo LogErr
10 j = 1 / 0 ' raises an error
okay:
Debug.Print "i=" & i
Exit Sub
LogErr:
MsgBox LogErrors("MyModule", "MyProc1", Err), vbExclamation, "Error " & Err.Number
Stop
Resume Next
End Sub
Public Function LogErrors( _
ByVal sModule As String, _
ByVal sProc As String, _
Err As ErrObject) As String
' Purpose: write error number, description and Erl to log file and return error text
Dim sLogFile As String: sLogFile = ThisWorkbook.Path & Application.PathSeparator & "LogErrors.txt"
Dim sLogTxt As String
Dim lFile As Long
' Create error text
sLogTxt = sModule & "|" & sProc & "|Erl " & Erl & "|Err " & Err.Number & "|" & Err.Description
On Error Resume Next
lFile = FreeFile
Open sLogFile For Append As lFile
Print #lFile, Format$(Now(), "yy.mm.dd hh:mm:ss "); sLogTxt
Print #lFile,
Close lFile
' Return error text
LogErrors = sLogTxt
End Function
' ログファイルを表示するための追加コード
Sub ShowLogFile()
Dim sLogFile As String: sLogFile = ThisWorkbook.Path & Application.PathSeparator & "LogErrors.txt"
On Error GoTo LogErr
Shell "notepad.exe " & sLogFile, vbNormalFocus
okay:
On Error Resume Next
Exit Sub
LogErr:
MsgBox LogErrors("MyModule", "ShowLogFile", Err), vbExclamation, "Error No " & Err.Number
Resume okay
End Sub