VBA最后更改方法

Question

我正在寻找一个功能,在评论框中打印,谁是从该单元格更改数据的用户.我现在拥有的是:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
   If Not Intersect(Range("C:JA"), Target) Is Nothing Then
     On Error GoTo EndeSub
     Application.EnableEvents = False
     Range("B" & Target.Row) = Now
   End If
EndeSub:
   Application.EnableEvents = True
 End Sub

当有人在单元格中键入内容时,它会自动"触发".并且只打印更改数据的最后一个用户名,但我想成为某种日志,以打印所有用户.你认为有可能吗？

Answer 1

一种方法是,插入一个新工作表并将其命名为"Log"并将这两个标题放置如下...

在日志表上

A1 - >日期/时间

B1 - >用户

现在用这个替换你现有的代码......

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
    Dim wsLog As Worksheet
    If Not Intersect(Range("C:JA"), Target) Is Nothing Then
        On Error GoTo EndeSub
        Set wsLog = Sheets("Log")
        Application.EnableEvents = False
        Range("B" & Target.Row) = Now
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 1) = Environ("UserName")
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1) = Now
    End If
EndeSub:
   Application.EnableEvents = True
End Sub

因此,每当任何用户在目标范围内进行更改时,更改时间和用户名将在日志表中列出.

编辑:

根据新设置,这些列标题应该位于日志表中.

A1 --> Date/Time
B1 --> User
C1 --> Cell
D1 --> Old Value
E1 --> New Value

然后用以下两个代码替换现有代码......

Dim oVal
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
    Dim wsLog As Worksheet
    If Not Intersect(Range("C:JA"), Target) Is Nothing Then
        On Error GoTo EndeSub
        Set wsLog = Sheets("Log")
        Application.EnableEvents = False
        Range("B" & Target.Row) = Now
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 1) = Environ("UserName")
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 2) = Target.Address(0, 0)
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 3) = oVal
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 4) = Target.Value
        wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1) = Now
    End If
EndeSub:
   Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Range("C:JA"), Target) Is Nothing Then
        oVal = Target
    End If
End Sub