如何使用 Excel VBA 制作外部日志？

How to make an external log using Excel VBA?

提问by Matt Ridge

The code has been updated to reference the changes below.

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

This log system create an external document for Excel called Log.txt, it will create a line in the log.txt file that looks like this:

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

11:27:20 AM Matthew Ridge changed cell $N$55 from ss to

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

This will not tell you if someone entered a new line of code into the sheet, but if the code demands an answer, it will tell you what cell that answer is in. This codes below should work for both Mac and PC systems combined. If people find it doesn't please say.

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

This code was created with the help of people here, and other forms, so I can't take sole proprietorship of the document, but I can take ownership of the concept. So thanks to those who helped, without this there now wouldn't be a viable logging system for Excel in my opinion ;)

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

BTW, before anyone freaks out and asks where does this code go, it isn't obvious to the general/new end user. You need to go to the Developer Tabopen it up, click on Visual Basic, and when the new window opens look for Microsoft Excel Object; under that folder should be your workbook. You can either put it under ThisWorkbook or inside any of the sheets by double clicking on the sheet you want the code to be in.

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

Once the sheet is open on the right panel, you will see Option Explicit, if you don't it is best if you activate it by making sure the Require Variable Declarationis checked. This is found at the Visual Basic window again, and follow this path:

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

Tools-> Options-> Editor.

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

If it is checked then you have no worry, if not then you check it. Option Explicit is a good thing for you code, it forces you to declare variables, which is a good practice to begin with.

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

After it is verified, you can copy the code below to either paste it in your Workbook, or a specific sheet depending on your needs.

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

Version 2.01

版本 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

As time goes by, I will attempt to update this code to add more features to it as I deem fit.

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

Again thanks to all that helped, it is greatly appreciated to make this possible.

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

采纳答案by Jason Clark

The problem is that when the you enter the merged cells, the value put into PreviousValue (in Worksheet_SelectionChange) is an array of all of the merged cells, which you can't compare to the the new value. When Worksheet_Changeis fired on the edit, the target is only the top-left cell of the merged range. So let's just track that cell for merged ranges. Replace your Worksheet_SelectionChangewith the following:

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

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

Disclaimer: This was tested on Excel for Mac 2011 as I don't have access to Excel for Windows at the moment, but I'm pretty sure that it will work on Excel for Windows as well.

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

回答by Matthew Schofield

Matt Ridge - I know you asked for a solution regarding multiple changes done at once, and i'm only 3 years to late, but here it is :). I've made some slight modifications to the original code, but this will handle merged cells and log multiple changes to cells.

马特里奇 - 我知道你要求关于一次完成多项更改的解决方案，我只迟到了 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

回答by OtisLoomgard

one year later i modified the Code from Matthew - now it tracks changes by copy/paste or tracking down the mouse too, thanks Matthew for the good idea!:

一年后，我修改了 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