Excel VBA 逆引き集 | データ改竄チェック

Excel VBA
スポンサーリンク

データ改竄チェック

誰かが「こっそり数値を変えている」—そんな不安を減らすための、初心者向けの“現場で効く”改竄検知テンプレです。ポイントは「監査ログ」「行シグネチャ（指紋）」「保護と例外」「比較レポート」の4本柱で運用を支えること。

改竄チェックの基本方針

  • 監査ログ: いつ・誰が・どこを・何から何へ変えたかを自動記録。
  • 行シグネチャ（指紋）: 重要列の値から軽量チェックサムを作り、前回の指紋と突合。
  • 保護: 重要セルをロック／データ検証で“うっかり改竄”を事前に防止。
  • 差分レポート: 意図しない変更がないか、まとめて見える化。

初心者でも扱えるように、暗号ハッシュ（SHA-256）ではなく「軽量チェックサム＋ログ」を中心にしています。十分に運用効果があり、まずはこれで“見える化”できます。

下準備ユーティリティ（速度・安全・指紋）

Option Explicit

'高速化
Private Sub SpeedOn()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Private Sub SpeedOff()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

'安全にシート用意
Private Function EnsureSheet(ByVal name As String, Optional ByVal clear As Boolean = False) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(name)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = name
    End If
    If clear Then ws.Cells.Clear
    Set EnsureSheet = ws
End Function

'行シグネチャ（軽量チェックサム）
'指定列の値を連結→各文字コードの総和＋位置XORで擬似的な指紋を作る
Private Function RowSignature(ByVal rngRow As Range, ByVal cols As Variant) As Long
    Dim i As Long, s As String, ch As Long, j As Long, sum As Long, x As Long
    For i = LBound(cols) To UBound(cols)
        s = s & "|" & CStr(rngRow.Cells(1, cols(i)).Value)
    Next
    For j = 1 To Len(s)
        ch = Asc(Mid$(s, j, 1))
        sum = sum + ch
        x = x Xor (ch + j)
    Next
    RowSignature = sum Xor x
End Function
VB
  • RowSignature: 重要列（例：コード・名称・単価）の値から軽量チェックサムを生成。列の並びや桁違いの変更でも変化が検知できます。
  • ハッシュほど厳密ではないですが、改竄検知には十分。厳密性が必要なら後で暗号ハッシュに差し替え可能。

監査ログを自動記録（Worksheet_Change）

対象シートで変更が起きたら、日時・ユーザー・アドレス・旧値・新値を「監査ログ」へ記録します。

'対象シートのコードモジュールに貼る（例：Sheet1）
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo fin
    Application.EnableEvents = False

    Dim wsLog As Worksheet: Set wsLog = EnsureSheet("監査ログ", False)
    If wsLog.Cells(1, 1).Value = "" Then
        wsLog.Range("A1:F1").Value = Array("日時", "ユーザー", "シート", "セル", "旧値", "新値")
    End If

    Dim c As Range
    For Each c In Target.Cells
        '旧値の取得：Worksheet_Changeでは難しいため、前回指紋運用と併用推奨
        'ここでは“直前値”を一時的に保存する仕組みがない前提で、新値のみ記録
        '（旧値は後述のシグネチャ比較やバックアップから再現可能）
        Dim r As Long: r = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row + 1
        wsLog.Cells(r, 1).Value = Now
        wsLog.Cells(r, 2).Value = Environ$("Username")
        wsLog.Cells(r, 3).Value = Me.Name
        wsLog.Cells(r, 4).Value = c.Address(0, 0)
        wsLog.Cells(r, 5).Value = "" '旧値は後述の指紋比較側で扱う
        wsLog.Cells(r, 6).Value = c.Value
    Next

fin:
    Application.EnableEvents = True
End Sub
VB
  • 初心者向け注意: Worksheet_Changeは“新値”しか直接取れません。旧値が要る場合は、変更前に別の仕組みで保持する必要があります（次セクションでカバー）。

指紋台帳の作成・検証（意図しない改竄を検知）

重要列の指紋を「指紋台帳」シートに保存→後で同じ行を再計算して照合。ズレがあれば改竄・変更として検出します。

'指紋台帳を作成（初期登録）
Sub BuildFingerprintLedger()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion '見出しあり
    Dim lastRow As Long: lastRow = rg.Rows.Count
    Dim cols As Variant: cols = Array(1, 2, 3) '例：A=コード, B=名称, C=単価

    Dim wsLed As Worksheet: Set wsLed = EnsureSheet("指紋台帳", True)
    wsLed.Range("A1:D1").Value = Array("行番号", "コード", "指紋", "備考")

    Dim r As Long, out As Long: out = 2
    For r = 2 To lastRow
        Dim sig As Long: sig = RowSignature(ws.Rows(r), cols)
        wsLed.Cells(out, 1).Value = r                      '行番号
        wsLed.Cells(out, 2).Value = ws.Cells(r, 1).Value   'コード（キー）
        wsLed.Cells(out, 3).Value = sig
        wsLed.Cells(out, 4).Value = ""
        out = out + 1
    Next

    wsLed.Columns.AutoFit
    SpeedOff
    MsgBox "指紋台帳の初期作成が完了しました。"
End Sub

'指紋台帳と現状の突合（改竄検知）
Sub VerifyFingerprintLedger()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    Dim cols As Variant: cols = Array(1, 2, 3) '重要列

    Dim wsLed As Worksheet: Set wsLed = EnsureSheet("指紋台帳", False)
    Dim wsReport As Worksheet: Set wsReport = EnsureSheet("改竄検知レポート", True)
    wsReport.Range("A1:E1").Value = Array("行番号", "コード", "旧指紋", "新指紋", "判定")

    Dim last As Long: last = wsLed.Cells(wsLed.Rows.Count, 1).End(xlUp).Row
    Dim i As Long, out As Long: out = 2
    For i = 2 To last
        Dim rowNo As Long: rowNo = CLng(wsLed.Cells(i, 1).Value)
        If rowNo < 2 Or rowNo > rg.Rows.Count Then GoTo cont
        Dim code As String: code = CStr(wsLed.Cells(i, 2).Value)
        Dim oldSig As Long: oldSig = CLng(wsLed.Cells(i, 3).Value)
        Dim newSig As Long: newSig = RowSignature(ws.Rows(rowNo), cols)

        If oldSig <> newSig Then
            wsReport.Cells(out, 1).Value = rowNo
            wsReport.Cells(out, 2).Value = code
            wsReport.Cells(out, 3).Value = oldSig
            wsReport.Cells(out, 4).Value = newSig
            wsReport.Cells(out, 5).Value = "差異あり"
            out = out + 1
        End If
cont:
    Next

    wsReport.Columns.AutoFit
    SpeedOff
    MsgBox "改竄検知レポートを作成しました。差異件数: " & out - 2
End Sub
VB
  • 運用: 更新後に「VerifyFingerprintLedger」を回すだけで、意図しない変更が検出できます。
  • 差分行の深掘り: 差異行は後述の“項目別差分”で何が変わったかを洗い出せます。

項目別差分の洗い出し（どこが変わったか）

改竄検知で見つかった行について、項目別に旧・新を比較して出力します。旧値は「改竄前バックアップ」か「台帳」から再現します。

'バックアップから旧値を復元して項目差分を出す例（簡易版）
Sub ReportFieldDifferences()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    Dim fields As Variant: fields = Array("名称", "単価", "カテゴリ") '比較したい見出し
    '見出し→列番号
    Dim i As Long, map() As Long: ReDim map(LBound(fields) To UBound(fields))
    For i = LBound(fields) To UBound(fields)
        map(i) = rg.Rows(1).Find(What:=fields(i), LookAt:=xlWhole, LookIn:=xlValues).Column
    Next

    '旧データは「Data_backup」から取得する前提
    Dim wsOld As Worksheet: Set wsOld = Worksheets("Data_backup")
    Dim rgOld As Range: Set rgOld = wsOld.Range("A1").CurrentRegion

    Dim wsOut As Worksheet: Set wsOut = EnsureSheet("項目差分", True)
    wsOut.Range("A1:E1").Value = Array("行番号", "項目", "旧値", "新値", "差分（数値のみ）")

    '改竄検知レポートの差異行を参照
    Dim wsDiff As Worksheet: Set wsDiff = Worksheets("改竄検知レポート")
    Dim lastDiff As Long: lastDiff = wsDiff.Cells(wsDiff.Rows.Count, 1).End(xlUp).Row

    Dim out As Long: out = 2
    Dim r As Long
    For r = 2 To lastDiff
        Dim rowNo As Long: rowNo = wsDiff.Cells(r, 1).Value
        For i = LBound(fields) To UBound(fields)
            Dim oldVal As Variant: oldVal = wsOld.Cells(rowNo, map(i)).Value
            Dim newVal As Variant: newVal = ws.Cells(rowNo, map(i)).Value

            Dim isNum As Boolean: isNum = (fields(i) Like "*単価*" Or fields(i) Like "*金額*" Or fields(i) Like "*在庫*")
            Dim diff As Boolean
            If isNum Then
                diff = (CDbl(Val(oldVal)) <> CDbl(Val(newVal)))
            Else
                diff = (CStr(oldVal) <> CStr(newVal))
            End If

            If diff Then
                wsOut.Cells(out, 1).Value = rowNo
                wsOut.Cells(out, 2).Value = fields(i)
                wsOut.Cells(out, 3).Value = oldVal
                wsOut.Cells(out, 4).Value = newVal
                wsOut.Cells(out, 5).Value = IIf(isNum, CDbl(Val(newVal)) - CDbl(Val(oldVal)), "")
                out = out + 1
            End If
        Next
    Next

    wsOut.Columns.AutoFit
    SpeedOff
    MsgBox "項目差分レポートを作成しました。差分行数: " & out - 2
End Sub
VB
  • バックアップの取り方: 更新前に「Data_backup」へ丸ごとコピーしておくと旧値が参照できます。例: Worksheets("Data").Cells.Copy Worksheets("Data_backup").Cells

改竄の予防（ロック・検証・例外ルール）

「見つけて直す」よりも、「入れさせない」設計が強いです。

Sub PreventTampering()
    Dim ws As Worksheet: Set ws = Worksheets("Data")
    '重要列をロック（名称・単価）してシート保護
    ws.Columns("B:C").Locked = True
    ws.Protect Password:="safe", AllowFiltering:=True, AllowSorting:=True

    'データ検証（単価は0以上の数値）
    With ws.Range("C2:C1000").Validation
        .Delete
        .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator:=xlGreaterEqual, Formula1:="0"
        .InputTitle = "単価"
        .InputMessage = "0以上の数値を入力してください"
        .ErrorTitle = "入力エラー"
        .ErrorMessage = "単価は0以上の数値のみ許可されます"
    End With
End Sub
VB
  • 例外対応: 承認者だけ編集できる“解錠マクロ”を用意し、作業後に再施錠する運用にすると安心。

例題で練習

'例1：初期の指紋台帳を作る
Sub Example_BuildLedger()
    BuildFingerprintLedger
End Sub

'例2：台帳と突合して改竄検知レポートを作る
Sub Example_VerifyLedger()
    VerifyFingerprintLedger
End Sub

'例3：差異行の項目別の旧・新を洗い出す
Sub Example_FieldDiffs()
    ReportFieldDifferences
End Sub

'例4：改竄予防（ロックと検証の設定）
Sub Example_Prevent()
    PreventTampering
End Sub
VB

実務の落とし穴と対策

  • 旧値が取れない問題
    • 対策: 更新前に「Data_backup」を必ず作る／“2段階差分”でプレビュー→適用に分ける。
  • 軽量チェックサムの衝突（まれ）
    • 対策: 重要列を増やす（コード＋名称＋単価＋在庫など）／必要に応じて暗号ハッシュへ移行。
  • シート保護の煩わしさ
    • 対策: 承認者のみ解錠できる短時間運用＋監査ログで可視化。
  • 列入替・見出し変更で誤検知
    • 対策: 指紋生成で“見出し名から列特定”にする、運用手順で列構成の変更は別フロー化。

スポンサーリンク
タイトルとURLをコピーしました