Vba 保存工作簿任何工作表中最后更改/修改的代码不准确

我以前提出过一个问题，我一直在使用上次保存的代码在代码的每一页上注册更改

更改的时间将记录在索引表上，以显示每张表的最后修改时间

但是，代码记录了我访问工作表的时间，没有修改，因此不准确

是否有其他更有效、更准确的解决方案来记录对工作表所做的更改，而不是访问

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

您的方法不好，因为您使用了工作表的索引，该索引表示工作表相对于其他工作表的放置位置/顺序。因此，如果移动工作表，代码将覆盖用于其他工作表的行

因此，我的建议基于图纸名称，该名称也可以更改，但它只会添加新行，而不会覆盖现有数据，并在第三列中添加了修改的范围

尝试一下：

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

---

我使用文件的最后修改日期来解决您的问题。它适用于已保存的文件

 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

---

我使用文件的最后修改日期来解决您的问题。它适用于已保存的文件

 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

---

如果这是工作簿中唯一的宏，则可以选择使用“轨迹更改”功能，而不是编写宏。注意：不能在共享工作簿中编辑宏。打开该功能后，您可以通过导航到“跟踪更改>突出显示更改>选择列出新工作表上的更改”来查看更改。您还可以选择显示自上次保存工作簿以来的所有更改或仅显示更改

下面是一个链接，其中包含有关共享工作簿中支持和不支持的功能的详细信息

轨道变更历史记录工作表示例：

---

如果这是工作簿中唯一的宏，您可以选择使用“轨迹更改”功能，而不是编写宏。注意：不能在共享工作簿中编辑宏。打开该功能后，您可以通过导航到“跟踪更改>突出显示更改>选择列出新工作表上的更改”来查看更改。您还可以选择显示自上次保存工作簿以来的所有更改或仅显示更改

下面是一个链接，其中包含有关共享工作簿中支持和不支持的功能的详细信息

轨道变更历史记录工作表示例：

---

---

必须有更多的代码。该代码只会对工作表上正在编辑的单元格做出反应，而不是简单地激活工作表。我如何才能扩展该代码？有什么想法吗@RoryNo，我的意思是如果你描述的是真的，你肯定已经有了更多的代码。这段代码根本不符合您所描述的。好吧，那么我该怎么做才能满足我的需求呢@Rory@Niva：我的上帝。。。看了你的档案后我几乎是色盲。。。不要在背景中放这么多颜色/图像，放一个类似灰色的颜色就足够了！不知什么原因，我不得不关闭你的文件20次，然后它才停止弹出再次打开…必须有更多的代码。该代码只会对工作表上正在编辑的单元格做出反应，而不是简单地激活工作表。我如何才能扩展该代码？有什么想法吗@RoryNo，我的意思是如果你描述的是真的，你肯定已经有了更多的代码。这段代码根本不符合您所描述的。好吧，那么我该怎么做才能满足我的需求呢@Rory@Niva：我的上帝。。。看了你的档案后我几乎是色盲。。。不要在背景中放这么多颜色/图像，放一个类似灰色的颜色就足够了！不知什么原因，我不得不关闭你的文件20次，然后它才停止打开…好吧，我明白你的担心，但它是否符合注册每张图纸所做更改的要求？是的。。。它确实。。。试试看，你会亲眼看到的；我试过了，但它仍然在记录我访问页面的时间：/真的不知道为什么它没有发生。如果您想查看excel工作簿，我已附加了上面的链接！嗯。。。它可能在你的文件中，但我已经检查过了，我的没有记录访问时间。那么，在工作表的模块或工作簿模块中是否有其他事件？是的，这将重写工作表中的每秒时间。。。所以你的问题肯定来自那个时钟；好的，我明白你的担心，但它是否符合登记每张图纸所做更改的要求？是的。。。它确实。。。试试看，你会亲眼看到的；我试过b

---

但它仍在记录我访问页面的时间：/真的不知道为什么没有发生。如果您想查看excel工作簿，我已附加了上面的链接！嗯。。。它可能在你的文件中，但我已经检查过了，我的没有记录访问时间。那么，在工作表的模块或工作簿模块中是否有其他事件？是的，这将重写工作表中的每秒时间。。。所以你的问题肯定来自那个时钟；这是文件，而不是相应的表格？因为它似乎不在工作表的基础上工作！当文件中的修改日期发生更改时，结果修改日期和相应的工作表名称将存储在索引表中。希望它满足您的要求。这是针对文件而不是针对相应的工作表？因为它似乎不在工作表的基础上工作！每当文件中的修改日期发生变化时，结果修改日期和相应的工作表名称都将存储在索引表中。希望它能满足您的要求，看起来令人印象深刻！多谢，我也会考虑这一选择：这让人印象深刻！多谢，我也会考虑这个选择：