1

这是一个通用日志系统，由这里的几个人和我自己创建。我对此感到相当自豪...我遇到了两个问题...如果有人可以提供解决方案，那就太好了。

这是代码：

Option Explicit
Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sLogFileName As String, nFileNum As Long, sLogMessage As String

    sLogFileName = ThisWorkbook.path & Application.PathSeparator & "Log.txt"

 On Error Resume Next ' Turn on error handling
    If Target.Value <> PreviousValue Then
        ' Check if we have an error
        If Err.Number = 13 Then
           PreviousValue = 0
        End If
        ' Turn off error handling
        On Error GoTo 0
        sLogMessage = Now & Application.UserName & " changed cell " & Target.Address _
        & " from " & PreviousValue & " to " & Target.Value

        nFileNum = FreeFile                         ' next file number
        Open sLogFileName For Append As #nFileNum   ' create the file if it doesn't exist
        Print #nFileNum, sLogMessage                ' append information
        Close #nFileNum                             ' close the file
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PreviousValue = Target(1).Value
End Sub

这是两个问题。

  1. 如果多次选择并尝试写入单元格，则脚本会出错。
  2. 如果有人编辑单元格并将其留空，它将显示8/30/2012 1:45:01 PM Matthew Ridge changed cell $K$3 from Test to而不是8/30/2012 1:45:01 PM Matthew Ridge changed cell $K$3 from Test to Blank or Empty
4

2 回答 2

3

马特

一些事情

  1. On Error Resume Next处理不当。除非绝对必要，否则应避免使用它。
  2. 当您使用Worksheet_Change事件时，最好关闭事件然后在最后重新打开它们以避免可能的无限循环。
  3. 如果您要关闭事件，则必须使用正确的错误处理。
  4. 由于您只存储一个单元格，PreviousValue所以我假设您不希望在用户选择多个单元格时运行代码？

我认为这就是您正在尝试的（未测试）？

Option Explicit

Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sLogFileName As String, nFileNum As Long, sLogMessage As String
    Dim NewVal

    On Error GoTo Whoa

    Application.EnableEvents = False

    sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt"

    If Not Target.Cells.Count > 1 Then
        If Target.Value <> PreviousValue Then
            If Len(Trim(Target.Value)) = 0 Then _
            NewVal = "Blank" Else NewVal = Target.Value

            sLogMessage = Now & Application.UserName & _
            " changed cell " & Target.Address & " from " & _
            PreviousValue & " to " & NewVal

            nFileNum = FreeFile
            Open sLogFileName For Append As #nFileNum
            Print #nFileNum, sLogMessage
            Close #nFileNum
        End If
    End If
LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PreviousValue = Target(1).Value
End Sub
于 2012-08-30T18:46:53.860 回答
1

This worked for me. Ideally you'd have a named range on the sheet being tracked which you could use to restrict tracking only to changes occuring inside that range.

Const MAX_TRACKED_CELLS As Long = 50
Dim PreviousValues As Object

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim haveDict As Boolean, val, addr

    haveDict = Not PreviousValues Is Nothing

    If Target.Cells.Count <= MAX_TRACKED_CELLS Then
        For Each c In Target.Cells
            addr = c.Address()
            If haveDict Then
                If PreviousValues.exists(addr) Then
                    val = PreviousValues(addr)
                End If
            Else
                val = "{unknown}"
            End If

            If c.Value <> val Then
                Debug.Print "Changed:", addr, IIf(val = "", "Empty", val), _
                            " to ", IIf(c.Value = "", "Empty", c.Value)
            End If

        Next c
    End If


End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim c As Range

    If PreviousValues Is Nothing Then
        Set PreviousValues = CreateObject("scripting.dictionary")
    Else
        PreviousValues.RemoveAll
    End If

    If Target.Cells.Count <= MAX_TRACKED_CELLS Then
        For Each c In Target.Cells
            PreviousValues.Add c.Address(), c.Value
        Next c
    End If

End Sub
于 2012-08-30T21:34:36.350 回答