9

代码已更新以引用以下更改。

此日志系统为 Excel 创建一个名为 Log.txt 的外部文档，它将在 log.txt 文件中创建如下所示的一行：

上午 11:27:20 Matthew Ridge 将单元格 $N$55 从 ss 更改为

这不会告诉您是否有人在工作表中输入了新的代码行，但如果代码需要答案，它会告诉您该答案在哪个单元格中。下面的代码应该适用于 Mac 和 PC 系统的组合。如果人们发现它不请说。

此代码是在此处的人员和其他形式的帮助下创建的，因此我不能独资拥有该文档，但我可以拥有该概念的所有权。所以感谢那些提供帮助的人，如果没有这个，我认为现在就不会有一个可行的 Excel 日志记录系统；）

顺便说一句，在任何人惊慌失措并询问这段代码去哪里之前，这对普通/新的最终用户来说并不明显。你需要去开发者标签打开它，点击Visual Basic，当新窗口打开时寻找Microsoft Excel对象；该文件夹下应该是您的工作簿。您可以通过双击您希望代码所在的工作表将其放在 ThisWorkbook 下或任何工作表内。

在右侧面板上打开工作表后，您将看到 Option Explicit，如果您不这样做，最好通过确保选中Require Variable Declaration来激活它。这又可以在 Visual Basic 窗口中找到，并遵循以下路径：

工具->选项->编辑器。

如果它被检查，那么你不用担心，如果没有，那么你检查它。Option Explicit 对你的代码来说是一件好事，它会强制你声明变量，这是一个很好的开始。

验证后，您可以复制下面的代码，将其粘贴到您的工作簿中，或者根据您的需要粘贴到特定的工作表中。

2.01 版

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

随着时间的推移，我将尝试更新此代码以添加更多我认为合适的功能。

再次感谢所有帮助，非常感谢使这成为可能。

4

3 回答 3

3

问题是当您输入合并的单元格时，放入 PreviousValue (in Worksheet_SelectionChange) 的值是所有合并单元格的数组，您无法将其与新值进行比较。当Worksheet_Change在编辑上触发时，目标只是合并范围的左上角单元格。因此，让我们只跟踪该单元格的合并范围。将您的替换Worksheet_SelectionChange为以下内容：

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

免责声明：这是在 Excel for Mac 2011 上测试的，因为我目前无法访问 Excel for Windows，但我很确定它也适用于 Excel for Windows。

于 2012-05-01T20:31:42.287 回答
1

Matt Ridge - 我知道你要求一个关于一次完成多项更改的解决方案，而我只迟到了 3 年，但它是 :)。我对原始代码做了一些细微的修改，但这将处理合并的单元格并记录对单元格的多项更改。

    选项显式
暗淡上一个值（）



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


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


 'Check all cells for changes, excluding D4 D5 E5 M1 etc
For r = 1 To Target.Count 
    If Target(r).Value <> PreviousValue(r) And Intersect(Target(r), Range("D4,D5,E5,M1")) Is Nothing Then 
         ' Check if we have an error
        If Err.Number = 13 Then 
            PreviousValue(r) = 0 

        End If 
         ' Turn off error handling
         'On Error GoTo 0
         'log data into .txt file
        sLogMessage = Now & " " & Application.UserName & " changed cell " & Target(r).Address _ 
        & " in " & ActiveSheet.Name & " from " & "'" & PreviousValue(r) & "' to '" & Target(r).Value & "'" & " in workbook " & ThisWorkbook.Path & " " & ActiveWorkbook.Name 

        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 
Next r 
End Sub 


Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Dim i As Long 

 'looks at the uppermost cell (incase cells are merged)

Redim PreviousValue(1 To Target.Count) 
For i = 1 To Target.Count 
    PreviousValue(i) = Target(i).Value 
Next i      
    End sub
于 2015-08-17T07:41:04.750 回答
1

一年后，我修改了 Matthew 的代码 - 现在它也通过复制/粘贴或跟踪鼠标来跟踪更改，感谢 Matthew 的好主意！：

'Paste this into a Module:

Option Explicit

'SheetArray to hold the old values before any change is made
Public aSheetArr() As Variant


'helperfunctions for last row and last col of a given sheet:

Function LastRow(sh As Worksheet)
'get last row of a given worksheet
sh.EnableAutoFilter = False
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
'get last col of a given worksheet
sh.EnableAutoFilter = False
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function


'Paste this into the workbook_Open method of your workbook (initializing the sheetarray)
Option Explicit

Private Sub Workbook_Open()
Dim lCol As Long
Dim lRow As Long

Dim wks As Worksheet
Set wks = Sheets(1)

lCol = LastCol(wks)
lRow = LastRow(wks)


aSheetArr = wks.Range(wks.Cells(1, 1), wks.Cells(lRow, lCol)) 'read the Range from the whole Sheet into the array


End Sub



'Paste this into the tablemodule - area where you want to log the changes:


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'logging all the changes in a worksheet - also the copy/past's and track down's over ceveral cells

    Dim sLogFileName As String, nFileNum As Long, sLogMessage As String, r As Long


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


 'Check all cells for changes, excluding D4 D5 E5 M1 etc
For r = 1 To Target.Count
    'compare each cell with the values from the old cell
    If Target(r).value <> aSheetArr(Target(r).Row, Target(r).Column) Then
         ' Check if we have an error
        If Err.Number = 13 Then
            PreviousValue(r) = 0

        End If
         ' Turn off error handling
         'On Error GoTo 0
         'log data into .txt file
        sLogMessage = Now & " " & Application.UserName & " changed cell " & Target(r).Address _
        & " in " & ActiveSheet.Name & " from " & "'" & aSheetArr(Target(r).Row, Target(r).Column) & "' to '" & Target(r).value & "'"

        'set the values in the array to the changed ones
        aSheetArr(Target(r).Row, Target(r).Column) = Target(r).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
Next r
End Sub
于 2016-06-21T13:38:02.843 回答