VBA上次更改方法

我正在寻找一个function，打印在评论框中，谁是从该单元格中更改数据的用户。 我现在所拥有的是：

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

一种方法是，插入一个新的工作表，并将其命名为“日志”，并将两个标题放置为这样…

在日志表上

A1 – >date/时间

B1 – >用户

现在用这个replace现有的代码…

 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 

然后用以下两个代码replace现有的代码…

 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 

Answer 2

在公共模块中

 Sub LogChange(Target As Range) Dim cell As Range, vNew As Variant, vOld As Variant vNew = Target.value Application.Undo vOld = Target.value Target.value = vNew With getLogWorksheet With .Range("A" & .Rows.Count).End(xlUp).Offset(1) ' Array("Date/Time", "UserName", "Worksheet", "Address", "Old Value", "New Value") .Resize(1, 6).value = Array(Now, Environ("UserName"), Target.Parent.Name, Target.Address(False, False), vOld, vNew) End With End With End Sub Private Function getLogWorksheet() As Workbook Dim ws As Worksheet On Error Resume Next Set ws = ThisWorkbook.Worksheets("Log") On Error GoTo 0 If ws Is Nothing Then Set ws = ThisWorkbook.Worksheets.Add ws.Visible = xlSheetVeryHidden ws.Name = "Log" ws.Range("A1").Resize(1, 6).value = Array("Date/Time", "UserName", "Worksheet", "Address", "Old Value", "New Value") End If End Function 

在工作表模块中

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.CountLarge > 1 Then Application.Undo MsgBox "Changing more than 1 cell at a time is prohibited", vbCritical, "Action Undone" ElseIf Not Intersect(Range("C:JA"), Target) Is Nothing Then LogChange Target End If End Sub 

Answer 3

另一点代码给你一些想法：

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) val_before = Target.Value End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then MsgBox Target.Count & " cells were changed!" Exit Sub End If If Target.Comment Is Nothing Then Target.AddComment existingcomment = "" Else existingcomment = Target.Comment.Text & vbLf & vbLf End If Target.Comment.Text Text:=Format(Now(), "yyyy-mm-dd") & ":" & vbLf & Environ$("Username") & _ " changed " & Target.Address & " from:" & vbLf & """" & val_before & _ """" & vbLf & "to:" & vblkf & """" & Target.Value & """" End Sub 

任何时候select一个单元格，它将单元格的现有值存储在一个variables中。 如果单元格被更改，它将在单元格中创build一个新的注释（或者附加现有注释，如果存在的话），包括date，用户名，单元格地址以及“之前和之后”值。 如果有人试图做出很多改变，这可能会超级烦人，如果同时有多个改变，那么它只会提醒你而不会创build评论。 如果有任何问题，我build议你练习一下空白的工作簿（或者正在工作的第二个副本）。 请确保Google的任何属性/方法都不是您所不熟悉的，为了学习的目的，以及构build一个满足您需求的解决scheme！