如何使用Excel VBA创建外部日志？

Question

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

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

  

11:27:20 AM Matthew Ridge从ss改变了$ 55美元到

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

这段代码是在这里的人和其他形式的帮助下创建的，所以我不能单独拥有该文件，但我可以掌握这个概念。所以感谢那些帮助过的人，没有这个，我认为现在不会有一个可行的Excel日志系统;）

顺便说一下，在有人吓坏了并询问这段代码的去向之前，对于普通/新的最终用户来说，这一点并不明显。您需要转到 Developer Tab 打开它，单击Visual Basic，当新窗口打开时，查找Microsoft Excel对象;在该文件夹下应该是您的工作簿。您可以将它放在ThisWorkbook下面，也可以通过双击希望代码所在的工作表在任何工作表内。

在右侧面板上打开工作表后，您将看到Option Explicit，如果不这样做，则最好通过确保选中需要变量声明来激活它。这可以再次在Visual Basic窗口中找到，并按照以下路径：

工具 - ＆GT; 选项 - ＆gt;的编辑即可。

如果检查过，那么你不用担心，如果没有，那么你检查一下。 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

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

再次感谢所有帮助，我们非常感谢能够实现这一目标。

Answer 1

问题在于，当您输入合并的单元格时，放入PreviousValue（在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。

Answer 2

马特里奇 - 我知道你要求一次性完成多项更改的解决方案，我只有3年才能到达，但这里是:)。 我对原始代码进行了一些细微的修改，但这将处理合并的单元格并记录对单元格的多个更改。

    Option Explicit 
Dim PreviousValue() 


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

Answer 3

一年后，我修改了马修的代码 - 现在它通过复制/粘贴或跟踪鼠标来跟踪更改，感谢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