使用 VBA 在 Excel 电子表格中记录更改

问题描述

我有以下问题。我需要在电子表格中记录更改。我的范围从 A1:M300000 开始。

到目前为止，我已经设法记录了更改单元格的地址、用户、旧值和新值。

现在我想插入以下函数并需要帮助。第一次接触VBA：

我还希望我的日志文件显示另一列中某个单元格的值。所以我知道它是哪个对象。示例更改单元格 B26，现在还应显示在日志文件中。

此外，我还想在插入新单元格或删除现有记录时进行记录。

这是我的 VBA 代码：

Option Explicit
Dim mvntWert As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim lngLast As Long
 
Set wks = Worksheets("Protokoll")
lngLast = wks.Range("A65536").End(xlUp).Row + 1
 
If Target.Count > 1 Then Exit Sub
If Intersect(Range("A1:M65536"),Target) Is nothing Then Exit Sub
 
With wks
    .Range("A" & lngLast).Value = Target.Address(0,0)
    .Range("B" & lngLast).Value = mvntWert
    .Range("C" & lngLast).Value = Target.Value
    .Range("D" & lngLast).Value = VBA.Environ("Username")
    .Range("E" & lngLast).Value = Now
    
End With
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Range("A1:M65536"),Target) Is nothing Then Exit Sub
mvntWert = Target.Value
End Sub

我希望有人能帮助我。预先非常感谢您。

问候

钢铁侠

解决方法

请尝试下一个代码，我昨天为其他人准备了类似的问题。它只需要一个事件，应该按照您的要求执行：

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim RangeValues As Variant,r As Long,boolOne As Boolean,TgValue 'the array to keep Target values (before UnDo)
 Dim sh As Worksheet: Set sh = Worksheets("Protokoll")
 Dim UN As String: UN = Application.userName
 
  'sh.Unprotect "" 'it should be good to protect the sheet
 If sh.Range("A1") = "" Then sh.Range("A1").Resize(1,6) = _
                                     Array("Time","User Name","Changed cell","From","To","Sheet Name")

 Application.ScreenUpdating = False                                     'to optimize the code (make it faster)
 Application.Calculation = xlCalculationManual
 
 If Target.cells.count > 1 Then
    TgValue = extractData(Target)
 Else
    TgValue = Array(Array(Target.value,Target.Address(0,0)))  'put the target range in an array (or as a string for a single cell)
    boolOne = True
 End If
 Application.EnableEvents = False                                'avoiding to trigger the change event after UnDo
     Application.Undo
     RangeValues = extractData(Target)                           'define the RangeValue
     putDataBack TgValue,ActiveSheet                            'put back the changed data
     If boolOne Then Target.Offset(1).Select
 Application.EnableEvents = True

 Dim columnHeader As String,rowHeader As String
 For r = 0 To UBound(RangeValues)
    If RangeValues(r)(0) <> TgValue(r)(0) Then
        sh.cells(rows.count,1).End(xlUp).Offset(1,0).Resize(1,6).value = _
                Array(Now,UN,RangeValues(r)(1),RangeValues(r)(0),TgValue(r)(0),Target.Parent.Name)
    End If
 Next r
 
 'sh.Protect ""
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub