セルの値変更を自動で履歴として記録する方法！ 変更前・変更後の値を保存するVBA | EXCELトピックス

Dim OldValues As Object ' 変更前の値を保存する辞書

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cell As Range
    
    ' 変更前の値を記録するための辞書を初期化
    Set OldValues = CreateObject("Scripting.Dictionary")
    
    ' 選択されたセルの値を辞書に保存
    For Each cell In Target
        If Not IsEmpty(cell.Value) Then
            OldValues(cell.Address) = cell.Value
        Else
            OldValues(cell.Address) = "(空白)"
        End If
    Next cell
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim oldValue As String

    ' 「変更履歴」シートが存在するか確認し、なければ作成
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("変更履歴")
    On Error GoTo 0

    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add
        ws.Name = "変更履歴"
        ' 見出しを設定
        ws.Cells(1, 1).Value = "No."
        ws.Cells(1, 2).Value = "変更日時"
        ws.Cells(1, 3).Value = "変更者"
        ws.Cells(1, 4).Value = "セルアドレス"
        ws.Cells(1, 5).Value = "変更前の値"
        ws.Cells(1, 6).Value = "変更後の値"
    End If

    ' 変更履歴を記録（複数セルの変更にも対応）
    For Each cell In Target
        ' 変更前の値を取得（辞書にない場合は空白）
        If OldValues.Exists(cell.Address) Then
            oldValue = OldValues(cell.Address)
        Else
            oldValue = "(不明)"
        End If

        ' 履歴の最終行を取得
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
        ws.Cells(lastRow, 1).Value = lastRow - 1
        ws.Cells(lastRow, 2).Value = Now
        ws.Cells(lastRow, 3).Value = Application.UserName
        ws.Cells(lastRow, 4).Value = cell.Address
        ws.Cells(lastRow, 5).Value = oldValue ' 変更前の値
        ws.Cells(lastRow, 6).Value = cell.Value ' 変更後の値
    Next cell
End Sub