保存工作簿任何工作表中上次更改/修改的代码不准确
我以前曾经提出一个问题，我一直在使用上次保存的代码在每个代码表上注册更改。
进行更改的时间将被logging在索引页上，以显示每张表的最后修改时间。
然而，代码logging了我访问表格的时间，而不是修改，因此使其不准确。
有没有其他更有效率和准确的解决scheme来注册对表单所做的更改而不是访问？
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range) If Sh.Name = "Index" Then Exit Sub i = Sh.Index With Sheets("Index") .Cells(i + 2, 1) = Sh.Name .Cells(i + 2, 2) = Now End With End Sub 这是代码
您的方法不好，因为您使用工作表的索引 ，这些索引代表与其他工作表有关的工作表放置的位置/顺序。 所以如果你移动你的工作表，你的代码将覆盖用于另一个工作表的行。
所以我根据表单名称 （也可以更改，但只添加新行，不覆盖现有数据 ），并在第三列中添加修改的范围。
试试这个：
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "Index" Then Exit Sub If Target.Cells.Count = 1 And Not Application.Intersect(Target, Range("A1")) Is Nothing Then Exit Sub Dim AlreadyExist As Boolean, _ LastRow As Integer, _ WsI As Worksheet Set WsI = ThisWorkbook.Sheets("Index") With WsI LastRow = .Range("A" & .Rows.Count).End(xlUp).Row AlreadyExist = False For i = 1 To LastRow 'Look for the good row to update If .Cells(i, 1) <> Sh.Name Then Else AlreadyExist = True .Cells(i, 2) = Now .Cells(i, 3) = Target.Address(False, False, xlA1) End If Next i 'If the sheet didn't exist, add a new line for it If AlreadyExist Then Else .Cells(LastRow + 1, 1) = Sh.Name .Cells(LastRow + 1, 2) = Now .Cells(LastRow + 1, 3) = Target.Address(False, False, xlA1) End If End With End Sub
我使用文件的最后修改date来解决你的问题。 它适用于已保存的文件。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range) Dim ws As Worksheet Dim wb As Workbook Dim MaxRange As Range Dim Maxvalue As Double Set wb = ThisWorkbook Set ws = ThisWorkbook.Sheets("Index") Set MaxRange = ws.Columns(2) sPath = wb.FullName 'Debug.Print Sh.Name Maxvalue = Application.WorksheetFunction.Max(MaxRange) 'Debug.Print Format(Maxvalue, "DD/mm/YYYY") If Sh.Name = "Index" Then Exit Sub ' Find the Last row lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(sPath) filemoddate = CDate(f.DateLastModified) ' Debug.Print filemoddate ' Debug.Print CDate(ws.Cells(lastrow, 2).Value) If filemoddate > CDate(Maxvalue) Then With ws.UsedRange Set rfound = .Find(Sh.Name, LookIn:=xlValues) If Not rfound Is Nothing Then lastrow = rfound.Row ' Print if the Modified Date if the file name present ws.Cells(lastrow, 2).Value = filemoddate Else ' Print if the Modified Date and Sheet Name if the file 'name is not present ws.Cells(lastrow + 1, 1).Value = Sh.Name ws.Cells(lastrow + 1, 2).Value = filemoddate End If End With End If Set f = Nothing Set fs = Nothing Set ws = Nothing Set wb = Nothing Set rfound = Nothing End Sub
如果这是工作簿中唯一的macros，则可以select使用“修订”function而不是编写macros。 （注意：macros不能在共享工作簿中编辑）。 打开function后，您可以通过导航到“修订”>“突出显示修改”>“在新工作表上select列表更改”来查看更改。 您也可以select显示所有更改，或仅显示自上次保存工作簿以来所做的更改。
以下链接提供了有关共享工作簿MS共享工作簿中不支持的function的更多信息
修订历史logging工作表的示例： 