excel - 在 Audit Trail 中记录多个单元格的复制粘贴和删除

Question

我找到了一个简单的代码来进行审计跟踪，但它仅适用于单个单元格。

如果有人复制粘贴几个单元格，它就会停止工作。一次删除几个单元格也是如此。

Option Explicit
Dim PreviousValue

Private Sub worksheet_change(ByVal target As Range)
 If target.Value <> PreviousValue Then
 Sheets("LOG").Cells(65000, 22).End(xlUp).Offset(1, 0).Value = Now & " / " & _
  Application.UserName & " / changed cell " & target.Address _
  & "  /from/ " & PreviousValue & " to " & target.Value
 End If
End Sub

Private Sub worksheet_selectionChange(ByVal target As Range)
  PreviousValue = target.Value
End Sub

Answer 1

好的。当复制的范围和选定的范围大小相同时，这是有效的。例如。您复制 A1:B5，然后选择其他 5 行 2 列的范围，然后粘贴。

首先添加两个名为VirtualCell和VirtualRange的类模块:

虚拟单元:

Option Explicit

Private pRow As Integer
Private pColumn As Integer
Private pValue As String


Public Property Get vRow() As Integer
    vRow = pRow
End Property

Public Property Let vRow(lRow As Integer)
    pRow = lRow
End Property

Public Property Get vColumn() As Integer
    vColumn = pColumn
End Property

Public Property Let vColumn(lColumn As Integer)
    pColumn = lColumn
End Property

Public Property Get vValue() As String
    vValue = pValue
End Property

Public Property Let vValue(lValue As String)
    pValue = lValue
End Property

虚拟范围:

Option Explicit

Private pCells As Collection

Private Sub Class_Initialize()
    Set pCells = New Collection
End Sub

Public Property Get vCells() As Collection
    Set vCells = pCells
End Property

Public Property Let vCells(lCells As Collection)
    pCells = lCells
End Property

Public Function GetvCell(ByVal row As Integer, ByVal col As Integer) As VirtualCell

    Dim vCell As VirtualCell

    For Each vCell In pCells
        If vCell.vColumn = col And vCell.vRow = row Then
            Set GetvCell = vCell
            Exit Function
        End If
    Next
End Function

然后将其粘贴到您的工作表代码中:

Option Explicit

Dim vRange As VirtualRange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim rngCell As Range

    Set vRange = New VirtualRange

    For Each rngCell In Target.Cells
        Dim vCell As VirtualCell
        Set vCell = New VirtualCell

        vCell.vColumn = rngCell.Column
        vCell.vRow = rngCell.row
        vCell.vValue = CStr(rngCell.Value2)

        vRange.vCells.Add vCell
    Next


End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngCell As Range

    For Each rngCell In Target.Cells
        If rngCell.Value <> vRange.GetvCell(rngCell.row, rngCell.Column).vValue Then
        Sheets("LOG").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = Now & " / " & _
             Application.UserName & " / changed cell " & rngCell.Address _
             & "  /from/ " & vRange.GetvCell(rngCell.row, rngCell.Column).vValue & " to " & rngCell.Value
        End If
    Next



End Sub