使用LastRow，Time Stamp和Workbook.sheetchange使用Excel VBA创建多个数据历史记录 [英] Creating multiple data histories with Excel VBA using LastRow, Time Stamp and Workbook.sheetchange

问题描述

我已经在Excel VBA中编写了一个手动宏，该宏显示2个或以后的多个表，以在称为评估"的工作表中显示某些数据的历史记录.我引用的数据在表清单"中.(如下所示)问题是清单"中的数据每天或更频繁地更改.每次工作表更改时，宏都应在评估"表的LastRow中插入带有新日期的新行.我想在评估"中显示数据的历史记录.因此，最后一次更改的行中的值应保持稳定.因此，例如评估"中的第1行:2020-01-17的值为1(应该保持为1，因为我想查看进度)现在工作表发生变化，并插入了第2行:第2行:2020-01-18现在的值是2(从清单复制)，我希望第1行中的值保持为1(因为在最后一次更改之前为1).这部分与我的第一个代码完美配合(请参见下文)，但是如果我也想记录第二个表的数据(代码2)，则什么也没发生...我是否只需要对我的第一个代码或如何进行调整好了吗?现在看起来像这样:

I have programmed a manual macro in Excel VBA that displays 2 or in the future multiple tables to show the history of certain data in a sheet called "evaluation". The data i reference to is in the table "checklist".(Look below) The problem is that the data in "checklist" changes every day or more often. Every time the sheet changes the macro should insert a new row with a new date into the LastRow of the table in "evaluation". I would like to display a history of the data in "evaluation". So the values in the row of the last change should stay stable. So for example row 1 in "evaluation": 2020-01-17 value is 1 (this should stay 1, because i want to see the progress) Now the sheet changes and row 2 gets inserted: row 2: 2020-01-18 value is now 2 (copied from checklist) and i want the value in row 1 to stay at 1 (because it was 1 before the last change). This part works perfectly with my 1st code: (see below), but if I want to record the data of the second table too (code 2) nothing happens... Do I have to just make an adjustment to my first code or how is it done? Right now it looks like this:

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

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

the first codes are for the first table and the one below is for the second table:

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专家.我制作了一个Google工作表来显示我的实际意思，但是我需要在excel VBA中使用它，而Google工作表只是为了可视化我的意思:

Do you have any ideas how to connect these codes? Sorry I am not really a VBA expert. I made a google sheet to show what I actually mean, but I need this in excel VBA, the google sheet is just to visualize what I mean: https://docs.google.com/spreadsheets/d/1OU_95Lhf6p0ju2TLlz8xmTegHpzTYu4DW0_X57mObBc/edit#gid=0

推荐答案

我认为您只是忘记添加"2".对于第二个代码，它仍然调用Test而不是Test2.

I think you just forgot to add a "2". For your second code, it still calls Test instead of calling Test2.

如果不是错误，我很乐意进行深入研究.但是，由于第一个对您有效，因此第二个也应适用.充满希望.

I'll be happy to dig in, if that isn't the error. But since the first one works for you, the second should work too. Lets hope.

在OP评论后进行

我的意思是您两次调用了子"Test"，却从未真正调用过Test2(我也没有在第二张图纸上看到2).

I meant you called the sub "Test" twice and never actually called Test2 (also I didnt see the 2 on your second sheetchange).

只需合并两个SheetChanges并正确调用TestX子即可.

Just merge the two SheetChanges and correctly call the 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 

这篇关于使用LastRow，Time Stamp和Workbook.sheetchange使用Excel VBA创建多个数据历史记录的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！