Question

这是一个通用的日志系统，这里和我自己创造了一些人。我为此感到自豪......我遇到了两个问题......如果有人可以帮助解决这个问题，那就太棒了。

以下是代码：

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

以下是两个问题。

如果选择了多个单元格并尝试写入，则脚本会出错。
如果有人编辑了一个单元格并将其留空，则会显示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

Answer 1

马特

少数事情

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

我认为这是你正在尝试的（ UNTESTED ）？

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

Answer 2

这对我有用。理想情况下，您在被跟踪的工作表上有一个命名范围，您可以使用它来限制仅跟踪该范围内发生的更改。

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

我有一个代码来记录excel表中的使用情况，但我得到一个错误，一个问题

2 个答案: