excel-vba
Excel-VBAの最適化

前書き

備考

ワークシートの更新を無効にする

ワークシートの計算を無効にすると、マクロの実行時間が大幅に短縮されます。さらに、イベント、画面更新、ページ区切りを無効にすることは有益です。後続の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)

MicroTimer ：

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