今回はVBA用のストップウォッチクラスを紹介します。
何番煎じですか
ストップウォッチと聞いて、
「はいはい。時間計測用のクラスね。何番煎じですか」
って思った貴方。
本当にVBAのストップウォッチクラスを見たことありますか？
私が求めているのは時間計測ではありません。
あくまでストップウォッチなのです。
ちゃんと一時停止と再開ができて、ラップタイムとかを取得できるものです。
私は見たことがありません。
（ほとんど検索してないので、ちゃんと探せばありそうですが）
ストップウォッチってなんだっけ？
ここまでの煽りは軽く流していただいて、ストップウォッチにはどんな機能があったか思い出してみましょう。
ま、万年文化系の部活だった私には、縁のない機械なんですけどね。
(たぶん一番流通している)ストップウォッチの機能
- ボタン1：スタート／停止／再開
- ボタン2：ラップ／スプリット表示
- ボタン1+2：リセット
かな？今はもっと進化してるのかもしれないけれど。
実務上のプログラムのベンチマークをする時は、どうしても計測に含めたく無いノイズが混ざってしまいます。
だから特定区間の時間を計測するためには、そこそこ面倒な計算をしなければなりません。
普通のストップウォッチなら一時停止が出来るので対応できますよね。
例えばこんなイメージです。
Sub 例えばこういうの() Dim i As Long, j As Long, k As Long Dim Ws As Worksheet Dim V As Variant 'ストップウォッチを開始 For Each Ws In ThisWorkbook.Worksheets '計測ここから For i = 1 To 100 For j = 1 To 100 V = Ws.Cells(i, j) Next Next '計測ここまで 'ストップウォッチを一時停止 '計測に含めたくない重い処理 MsgBox "適当に待ち時間" 'ストップウォッチを再開 '計測ここから For i = 1 To 100 For j = 1 To 100 V = Ws.Cells(i, j) Next Next '計測ここまで Next 'ストップウォッチを終了 MsgBox "それぞれの計測結果を表示" End Sub
とにかく私は、こういった機能まで備えたストップウォッチクラスが欲しかったので作りました。
機能説明
実在するストップウォッチのインターフェースと同じように組むことも出来るのですが、VBAで使うとなると見直したほうが良さそうです。
そこで私はこのような機能を持たせました。
| プロシージャ | 機能説明 |
|---|---|
| StartTimer | スタート：リセットして計測を開始 |
| ClearTimer | クリア：リセットして他の機能を封印 |
| PauseTimer | 停止：停止時間を記憶 |
| ResumeTimer | 再開：計測を再開 |
| SplitTime | スプリット：開始からの経過時間 |
| LapTime | ラップ：直前の計測からの経過時間 ※スプリットの影響は受けない。 |
| Laps | ラップした時間の配列 |
クリアは正直必要ないと思うんですけどね。
インスタンス作り直せばいいし・・・。
ストップウォッチクラス ソースコード
clsStopWatch
Option Explicit '高機能ストップウォッチクラス (64bit暫定対応。動作未検証） 'Byことりちゅん 'https://www.excel-chunchun.com/entry/2019/02/03/233535 ' 'ver 1.0 : 2019/2/3 当初 Private Const CLASS_NAME = "clsTimer" '※エラーコードは適当 Private Const NOSTART_ERROR_CODE = 8001 Private Const NORESET_ERROR_CODE = 8002 Private Const NOSTART_ERROR_MESSAGE = "タイマーが開始されていません。" Private Const NORESET_ERROR_MESSAGE = "タイマーが初期化されていません。" Private StartNum As Long Private LapNum As Long Private PauseNum As Long '停止時間の一時記憶変数 Private LapTimes As Collection Private DefaultFormat As String #If VBA7 Then #If Win64 Then Private Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong #Else Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long #End If #Else Private Declare Function GetTickCount Lib "kernel32" () As Long #End If 'スタート：リセットして計測を開始 Public Sub StartTimer(Optional defFormat As String = "") If StartNum <> 0 Then Err.Raise NORESET_ERROR_CODE, CLASS_NAME, NORESET_ERROR_MESSAGE DefaultFormat = defFormat #If Win64 Then StartNum = CLng(GetTickCount64) #Else StartNum = GetTickCount #End If LapNum = StartNum PauseNum = 0 Set LapTimes = New Collection End Sub 'クリア：リセットして機能を使えないようにする Public Sub ClearTimer() StartNum = 0 LapNum = 0 PauseNum = 0 Set LapTimes = Nothing End Sub 'ポーズ：一時停止：停止時間を記憶 Public Sub PauseTimer() If StartNum = 0 Then Err.Raise NOSTART_ERROR_CODE, CLASS_NAME, NOSTART_ERROR_MESSAGE #If Win64 Then PauseNum = CLng(GetTickCount64) #Else PauseNum = GetTickCount #End If End Sub 'リズム：再開：停止していた時間分を開始時間に足すことで辻褄をあわせる Public Sub ResumeTimer() If PauseNum = 0 Then Exit Sub '非ポーズ中 #If Win64 Then StartNum = StartNum + (CLng(GetTickCount64) - PauseNum) LapNum = LapNum + (CLng(GetTickCount64) - PauseNum) #Else StartNum = StartNum + (GetTickCount - PauseNum) LapNum = LapNum + (GetTickCount - PauseNum) #End If PauseNum = 0 End Sub 'スプリット：開始からの経過時間 Public Function SplitTime(Optional ByVal timeFormat As String = "") As Variant If StartNum = 0 Then Err.Raise NOSTART_ERROR_CODE, CLASS_NAME, NOSTART_ERROR_MESSAGE Dim tm As Long #If Win64 Then tm = CLng(GetTickCount64 - StartNum) #Else tm = (GetTickCount - StartNum) #End If If timeFormat = "" Then timeFormat = DefaultFormat If timeFormat = "" Then SplitTime = tm Else SplitTime = GetTimeFormat(tm, timeFormat) End If End Function 'ラップ：直前の計測からの経過時間 Public Function LapTime(Optional ByVal timeFormat As String = "") As Variant If StartNum = 0 Then Err.Raise NOSTART_ERROR_CODE, CLASS_NAME, NOSTART_ERROR_MESSAGE Dim tm As Long #If Win64 Then tm = CLng(GetTickCount64 - LapNum) LapNum = CLng(GetTickCount64) #Else tm = (GetTickCount - LapNum) LapNum = GetTickCount #End If If timeFormat = "" Then timeFormat = DefaultFormat If timeFormat = "" Then LapTime = tm Else LapTime = GetTimeFormat(tm, timeFormat) End If LapTimes.Add LapTime End Function 'ラップタイムのコレクションを返す Public Property Get Laps() As Variant If StartNum = 0 Then Err.Raise NOSTART_ERROR_CODE, CLASS_NAME, NOSTART_ERROR_MESSAGE If LapTimes.Count = 0 Then Laps = Split(vbNullString) Else Dim arr() As Variant ReDim arr(1 To LapTimes.Count) Dim i As Long For i = 1 To LapTimes.Count arr(i) = LapTimes(i) Next Laps = arr End If End Property 'ミリセコンドから任意の書式に変換 Private Function GetTimeFormat(tm As Long, timeFormat As String) As Variant Select Case True Case timeFormat = "s" GetTimeFormat = CDbl(tm) / 1000 Case timeFormat = "ms" GetTimeFormat = tm Case timeFormat Like "*ms" GetTimeFormat = Right(String(10, " ") & Format(tm, timeFormat), 10) Case timeFormat Like "*s" GetTimeFormat = Right(String(10, " ") & Format(CDbl(tm) / 1000, timeFormat), 10) Case Else GetTimeFormat = Format(tm, timeFormat) End Select End Function
検証用プロシージャ ソースコード
任意のモジュール(clsStopWatch_test等)
Option Explicit 'clsStopWatch検証用プロシージャ Sub Test_StopWatch() Const TEST_COUNT = 5 Const TEST_ROWS = 100 Const TEST_FORMAT = "0ms" Const TEST_SHEET = "StopWatchTest" '一時シートの生成 ActiveWorkbook.Worksheets.Add Dim Ws As Worksheet Set Ws = ActiveWorkbook.ActiveSheet Ws.Name = TEST_SHEET '必要な変数宣言 Dim cSW As clsStopWatch Set cSW = New clsStopWatch Dim i As Long, j As Long '以下メイン処理 Debug.Print "-----個別出力-----" cSW.StartTimer TEST_FORMAT For i = 1 To TEST_COUNT Ws.Cells.Clear For j = 1 To TEST_ROWS Ws.Cells(j, 1).Value = "個別出力だああああ" Next Debug.Print "ラップ：" & cSW.LapTime() & "" Next Debug.Print "合計 ：" & cSW.SplitTime() & "" '中断・再開の検証、及びラップ一覧の表示 cSW.PauseTimer MsgBox "ラップ一覧" & vbLf & Join(cSW.Laps, vbLf), vbOKOnly, "個別出力" cSW.ResumeTimer 'メッセージボックス表示中の時間が進んでなければOK Debug.Print "中断後：" & cSW.SplitTime() & "" cSW.ClearTimer Debug.Print "-----一括出力-----" cSW.StartTimer TEST_FORMAT For i = 1 To TEST_COUNT Ws.Cells.Clear Ws.Cells(1, 1).Resize(TEST_ROWS, 1).Value = "一括出力だああああ" Debug.Print "ラップ：" & cSW.LapTime() & "" Next Debug.Print "合計 ：" & cSW.SplitTime() & "" cSW.PauseTimer MsgBox "ラップ一覧" & vbLf & Join(cSW.Laps, vbLf), vbOKOnly, "一括出力" cSW.ResumeTimer Debug.Print "中断後：" & cSW.SplitTime() & "" cSW.ClearTimer '一時シートの削除 On Error Resume Next Application.DisplayAlerts = False ActiveWorkbook.Worksheets(TEST_SHEET).Delete Application.DisplayAlerts = True On Error GoTo 0 End Sub
尚、あまり頻繁にラップやスプリットを読み込むと、ストップウォッチの負荷が無視できない誤差となるので注意しましょう。
検証風景
まとめ
というわけでストップウォッチクラスの紹介でした。
これなら誰に向かっても「ストップウォッチ」って堂々と宣言できますよね！
実は今まで、時間の計測は適当にやっていたのですが、今後はこれに統一していきたいと思います。
＝作ったばかりなのでデバッグしきれてないかもしれません。
また、64bit Officeが手元にないので、仮です。後日検証する事ができたら更新します。
以上
追記
大幅に仕様を変更したため別記事にて再投稿しました。（2019/2/5追記）
何か御座いましたらコメント欄、またはTwitterからどうぞ♪
それではまた来週♪ ちゅんちゅん(・8・)
