VBAでerror messageを集計で最初に求められるのはcommand暗記ではなく、何を正しい結果とするかの定義です。結論は「source列を最後の行まで読み、blankを除外し、Scripting.Dictionaryでmessageごとの件数を数えます。出力sheetを毎回上書きする前に作業copyを使い、元messageと正規化keyを両方残します。」。raw logを変更せず、messageの正規化ruleとblank/error cellの扱いを固定することを確認し、表示、加工、変更を混同しない順序で進めます。 確認ポイント：集計結果はmessage正規化とExcel error cellの採否を同じ規則で再現できる場合にだけ比較できます。
集計対象列と正規化規則を先に決める
エラーメッセージ集計では、入力列の範囲、空白、数式エラー、前後空白、大文字小文字の扱いを最初に決めます。元ブックを複製し、Dictionaryへ入れる正規化後の文字列と原文を分けて保持します。集計表の件数合計が有効入力件数と一致し、同じメッセージが一行だけ出ることを確認します。
- source sheet、header、最終行、message列を確認する
- blank、Excel error値、数字、改行を別に扱う
- 大小文字、前後空白、可変IDを同一化するかruleを決める
- 出力sheetの既存dataとsort範囲を確認する
Dictionary集計から出力sheetまでを組み立てる
Log sheetの最終行を確認する
Sub InspectErrors()
Dim ws As Worksheet, lastRow As Long
Set ws = ThisWorkbook.Worksheets("Log")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Debug.Print lastRow, ws.Range("A2").Value2
End Sub固定A1:A100ではなくheader下から最終行を確認します。
大文字小文字を無視してmessageを数える
Sub CountMessages()
Dim d As Object, c As Range, key As String
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
For Each c In ThisWorkbook.Worksheets("Log").Range("A2:A1000")
If Not IsError(c.Value) Then
key = Trim$(CStr(c.Value2))
If Len(key) > 0 Then d(key) = d(key) + 1
End If
Next c
Debug.Print d.Count
End Sub実rangeは確認したlastRowへ置き換えます。
ErrorSummaryへkeyと件数を出力する
Dim outWs As Worksheet, i As Long, k As Variant
Set outWs = ThisWorkbook.Worksheets("ErrorSummary")
i = 2
For Each k In d.Keys
outWs.Cells(i,1).Value2 = k
outWs.Cells(i,2).Value2 = d(k)
i=i+1
Next k既存summaryを消す前にbackupし、headerを明示します。
件数列で降順sortする
With outWs.Sort
.SortFields.Clear
.SortFields.Add Key:=outWs.Range("B2:B" & i-1), Order:=xlDescending
.SetRange outWs.Range("A1:B" & i-1)
.Header = xlYes
.Apply
End WithActiveSheetのRangeを混ぜません。
採用件数とsummary合計を照合する
Debug.Assert WorksheetFunction.Sum(outWs.Range("B2:B" & i-1)) = WorksheetFunction.CountA(ThisWorkbook.Worksheets("Log").Range("A2:A1000"))blankやerror cellを除外する場合は期待件数も同じruleで計算します。
空白・Excel error値・表記揺れを除外する
messageの完全一致集計はtimestampやIDが埋め込まれると細分化されます。正規化する場合は原文を保持し、どのpatternを置換したか記録します。vbTextCompareは大小文字を同一視しますが、日本語全角半角やUnicode正規化は別です。Excel error cellはCStrするとerrorになるためIsErrorで分けます。
部分一致と完全一致の集計を混同しない
- blankも一つのmessageとして数える
- Error cellでCStrする
- ActiveSheetに出力する
- sort rangeをqualifyしない
- 正規化後に原文を失う
出力sheet以外を消去しない停止条件
集計はsourceを読み取るだけにし、色付けやfilterは出力sheetへ限定します。messageにuser名やticket本文がある場合はsummaryの共有範囲を確認します。macro実行前にworkbook copyを作り、Application.Calculation/ScreenUpdating/EnableEventsを変えた場合はerror handlerで元へ戻します。誤出力時はsummary sheetだけをbackupから戻します。
accepted・rejected・key数を証跡にする
source非blank件数、dictionary count合計、出力count合計を一致させます。大小文字、空白、改行、Excel error、同文反復のsampleをtestし、二回実行して重複追記されないことを確認します。
エラーメッセージ集計の合格基準
Log sheetの最終行までをScripting.Dictionaryで集計し、blankとExcel error値を除外してErrorSummaryへ出します。dictionary、出力sheet、sort範囲を同じSubのlocal変数として保持し、断片を別々に実行して未定義変数へ依存しません。
一つのSubで完結する集計コード
Option Explicit
Public Sub BuildErrorSummary()
Dim src As Worksheet, dst As Worksheet
Dim lastRow As Long, r As Long, outRow As Long
Dim d As Object, key As String, k As Variant
Dim accepted As Long, rejected As Long
On Error GoTo Fail
Set src = ThisWorkbook.Worksheets("Log")
Set dst = ThisWorkbook.Worksheets("ErrorSummary")
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
lastRow = src.Cells(src.Rows.Count, "A").End(xlUp).Row
For r = 2 To lastRow
If IsError(src.Cells(r, "A").Value) Then
rejected = rejected + 1
Else
key = Trim$(CStr(src.Cells(r, "A").Value2))
If Len(key) > 0 Then
If d.Exists(key) Then d(key) = CLng(d(key)) + 1 Else d.Add key, 1
accepted = accepted + 1
End If
End If
Next r
dst.Cells.ClearContents
dst.Cells(1, 1).Value2 = "Message"
dst.Cells(1, 2).Value2 = "Count"
outRow = 2
For Each k In d.Keys
dst.Cells(outRow, 1).Value2 = CStr(k)
dst.Cells(outRow, 2).Value2 = CLng(d(k))
outRow = outRow + 1
Next k
If outRow > 2 Then
With dst.Sort
.SortFields.Clear
.SortFields.Add Key:=dst.Range("B2:B" & outRow - 1), Order:=xlDescending
.SetRange dst.Range("A1:B" & outRow - 1)
.Header = xlYes
.Apply
End With
Debug.Assert CLng(WorksheetFunction.Sum(dst.Range("B2:B" & outRow - 1))) = accepted
Else
Debug.Assert accepted = 0
End If
Debug.Print "accepted=" & accepted, "rejectedErrorCells=" & rejected, "keys=" & d.Count
Exit Sub
Fail:
MsgBox "BuildErrorSummary failed: " & Err.Number & " " & Err.Description, vbExclamation
End Subこのcodeは画面表示だけを見るための例ではありません。通常系では「非blank・非errorの入力件数とsummary Count列合計が一致し、message別件数が正しい」を確認し、0件と実行errorを別の結果として保存します。
正常message・空白・cell errorを分類する
- 期待どおり：非blank・非errorの入力件数とsummary Count列合計が一致し、message別件数が正しい
- 0件・非適用：有効message 0件ならheaderだけを残してNoRowsとして正常終了する
- 実行error：sheet/table不存在、出力保護、sort errorはErr.Numberを表示し、途中summaryを完成扱いしない
固定A2:A1000で末尾を切らず、lastRowを取得します。大文字小文字を同一視するかはCompareModeで固定し、正規化後のkeyと原文sampleを必要に応じて分けます。既存summaryはcopyで保全してからclearします。
case差・空範囲・同数順位を試す
' Log!A2:A6 に Err A / err a / blank / CVErr(xlErrNA) / Err B を置き、
' summary合計=3、vbTextCompare時のkey数=2を確認する。blank、Excel error、大小文字、前後空白、1000行超、0件をtestします。scanned行数、accepted/rejected件数、dictionary key数、summary合計、二回実行後の重複なしを記録します。
Excel VBAでエラーメッセージの発生回数を集計する方法の証跡には、実行対象と取得時刻に加え、通常・0件・errorのどれへ分類したかを残します。通常系は「非blank・非errorの入力件数とsummary Count列合計が一致し、message別件数が正しい」、停止系は「sheet/table不存在、出力保護、sort errorはErr.Numberを表示し、途中summaryを完成扱いしない」を判断文としてそのまま作業票へ写し、担当者ごとの言い換えで意味が変わらないようにします。
error集計macroを反復実行する場合は、固定行数ではなくtableまたは採用した最終行をrun開始時に確定し、集計先を新しい作業sheetへ出します。既存summaryへの追記は行わず、run IDごとに置換して再実行の二重計上を防ぎます。集計総数が読取行数から除外行数を引いた値と一致しなければ成果物を採用せず、CalculationとScreenUpdatingを元へ戻して終了します。
コメント