Question

我想使用注释来记录单元格中的每个更改，但是每次执行代码时Excel都会崩溃。

对于“撤消”部分，我还有其他更好的方法来记录旧值和新值吗？

有人可以给我一些建议吗？谢谢

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range
Dim ws As Worksheet

For Each r In Target

    new_value = r.Value
    Application.Undo
    old_value = r.Value
    r.Value = new_value

    If r.Value = "" And r.Comment Is Nothing Then
        r.AddComment.Text Application.UserName & " has added " & new_value & " at " & Now

    ElseIf r.Value <> "" And r.Comment Is Nothing Then
        r.AddComment.Text Application.UserName & " has changed from " & old_value & " to " & new_value & " at " & Now

    ElseIf Not r.Value = "" And r.Comment Is Nothing Then
        r.Comment.Text Application.UserName & " has changed from " & old_value & " to " & new_value & " at " & Now

    End If

Next
End Sub

Answer 1

为了避免Excel陷入无限循环，您需要关闭事件

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range
Dim ws As Worksheet

Application.EnableEvents = False

For Each r In Target

    new_value = r.Value
    Application.Undo
    old_value = r.Value
    r.Value = new_value

    If r.Value = "" And r.Comment Is Nothing Then
        r.AddComment.Text Application.UserName & " has added " & new_value & " at " & Now

    ElseIf r.Value <> "" And r.Comment Is Nothing Then
        r.AddComment.Text Application.UserName & " has changed from " & old_value & " to " & new_value & " at " & Now

    ElseIf Not r.Value = "" And r.Comment Is Nothing Then
        r.Comment.Text Application.UserName & " has changed from " & old_value & " to " & new_value & " at " & Now

    End If

Next

Application.EnableEvents = True

End Sub

现在，您可以检查代码是否在执行您想要的操作。

使用注释记录单元格中的每个更改

1 个答案: