ステータスバーの更新頻度を下げて処理速度を向上させる：Excel VBA

Option Explicit
 
Declare Function QueryPerformanceFrequency Lib "kernel32" (frequency As Double) As Long
Declare Function QueryPerformanceCounter Lib "kernel32" (procTime As Double) As Long
 
Function GetMicroSecond() As Double
    Dim procTime            As Double       '// 高分解能パフォーマンスカウンタ値（システム起動からの加算値）
    Dim frequency           As Double       '// 高分解能パフォーマンスカウンタの周波数（１秒間に増えるカウントの数）
    Dim ret                 As Double       '// 計測結果
    '// 計測時刻を0で初期化
    GetMicroSecond = 0
    '// 更新頻度を取得
    Call QueryPerformanceFrequency(frequency)
    '// 処理時刻を取得
    Call QueryPerformanceCounter(procTime)
    '// カウンタ値を１秒間のカウント増加数で割り、正確な時刻を算出
    GetMicroSecond = procTime / frequency
End Function
 
Sub StatusBarUpdate(msg As String, Optional wait_sec As Double = 0.1)
    Static StatusBarUpdate_LastUpdateTime As Double
    Dim now_time As Double
    now_time = GetMicroSecond
    If now_time - StatusBarUpdate_LastUpdateTime > wait_sec Then
        Application.StatusBar = msg
        StatusBarUpdate_LastUpdateTime = now_time
        DoEvents
    End If
End Sub