使用Excel VBA使用LastRow、时间戳和Workbook.sheetchange创建多个数据历史记录

我在Excel VBA中编程了一个手动宏，它显示2个或将来的多个表，以在一个名为“评估”的表中显示某些数据的历史记录。我提到的数据在检查表中。看看下面，问题是检查表中的数据每天都在变化，或者更频繁。每次工作表更改时，宏都应在评估表的最后一行插入一个带有新日期的新行。我想在评估中显示数据的历史记录。因此，上次更改行中的值应保持稳定。例如，评估：2020-01-17中的第1行的值为1，这应该保持为1，因为我希望看到工作表更改和第2行插入后的进度：第2行：2020-01-18的值现在是从检查表中复制的2，我希望第1行的值保持为1，因为在上次更改之前是1。 这一部分与我的第一个代码完美配合：见下文，但如果我想记录第二个表的数据，代码2不会发生任何事情。。。我是否需要对我的第一个代码进行调整，或者如何调整？现在看起来是这样的：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "checklist" Then
          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("A3:E3")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If
    End If
End Sub


Private Sub Test(target As Range)
    Dim LastRow As Long

    LastRow = Range("evaluation!A" & Sheets("evaluation").Rows.Count).End(xlUp).Row

    If Range("evaluation!A1").Value <> "" Then
       LastRow = LastRow + 1
    End If
    'every change A3:E in checklist will insert row to this evaluation
    'but if different please you decide here
    Range("evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
    Range("evaluation!B" & LastRow & ":F" & LastRow).Value = Range("checklist!A" & target.Row & ":E" & target.Row).Value
End Sub

第一个代码用于第一个表，下面的代码用于第二个表：

Private Sub Workbook_SheetChange2(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "checklist" Then
          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("G3:K3")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If
    End If
End Sub


Private Sub Test2(target As Range)
    Dim LastRow As Long

    LastRow = Range("evaluation!H" & Sheets("evaluation").Rows.Count).End(xlUp).Row

    If Range("evaluation!H1").Value <> "" Then
       LastRow = LastRow + 1
    End If
    'every change A3:E in checklist will insert row to this evaluation
    'but if different please you decide here
    Range("evaluation!H" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
    Range("evaluation!I" & LastRow & ":M" & LastRow).Value = Range("checklist!G" & target.Row & ":K" & target.Row).Value
End Sub

---

你知道如何连接这些代码吗？对不起，我不是真正的VBA专家。我制作了一个谷歌表来显示我的实际意思，但我需要在excel VBA中使用它，谷歌表只是为了形象化我的意思：

我想你只是忘了添加一个2。对于第二个代码，它仍然调用Test而不是Test2

如果不是错误的话，我很乐意深入研究。但既然第一个对你有用，第二个也应该有用。让我们期待吧

操作后编辑注释：

我的意思是你调用了两次子测试，但实际上从未调用过测试2。我也没有在你的第二张表上看到2

只需合并两个sheetchange并正确调用TestX subs

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "checklist" Then

          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("A3:E3")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If

          If Not Intersect(target, Range("G3:K3")) Is Nothing Then
             'if any monitoring here, please you add here
             Test2 target 'Here procedure to insert
          End If
    End If

End Sub 

这是我的方法

将范围转换为Excel表格 把代码放在检查表后面 检查表 该表中的表名：TableCheckList

评估表 该表中的表名TableHistory01和TableHistory02

代码：

一些评论：

每次更改单元格时，代码都会添加行。这是预期的目的吗？也许当清单中的一行被更改/添加时？ 您提到要记录天数，但您的代码也在添加时间 这是一个

某些到即将列出Excel表中的对象

---

让我知道它是否有效

此专用子工作簿\u SheetChange2。。。绝对不是有效的工作簿事件那么什么才是有效的工作簿事件？您的代码当前仅监视此范围3:E3，因此我认为这只是一个错误。您是否能够将清单和评估中的范围转换为？这将简化整个方法。Excel和Google表单看起来完全相同。这不是外观问题，而是结构问题。如果您可以将它们转换为Excel表格，请参阅我发布的链接，我可以帮助您使用它们来解决问题。那么您的意思是测试目标必须是测试2目标？它必须与您为新sub指定的名称相同，即Test2。请参阅“希望正确”工作簿的“工作表更改”子部分的编辑

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim checkListTable As ListObject
    Dim checkListRow As ListRow

    Set checkListTable = Range("TableCheckList").ListObject

    If Intersect(Target, checkListTable.DataBodyRange) Is Nothing Then Exit Sub

    Set checkListRow = checkListTable.ListRows(Target.Row - checkListTable.HeaderRowRange.Row)

    AddHistory Target, "TableHistory01", checkListRow

    AddHistory Target, "TableHistory02", checkListRow

End Sub

Private Sub AddHistory(ByVal Target As Range, ByVal HistoryTableName As String, ByVal checkListRow As ListRow)

    Dim historyTable As ListObject
    Dim newRow As ListRow

    Set historyTable = ThisWorkbook.Worksheets("Evaluation").ListObjects(HistoryTableName)

    ' Add a row to that table
    Set newRow = historyTable.ListRows.Add(alwaysInsert:=True)

    ' Fill the row with source values
    With newRow
        .Range.Cells(1).Value = Format(Now, "dd.mm.yyyy hh:mm")
        .Range.Cells(2).Value = checkListRow.Range.Cells(1)
        .Range.Cells(3).Value = checkListRow.Range.Cells(2)
        .Range.Cells(4).Value = checkListRow.Range.Cells(3)
        .Range.Cells(5).Value = checkListRow.Range.Cells(4)
        .Range.Cells(6).Value = checkListRow.Range.Cells(5)
    End With

End Sub