使用 LastRow、Time Stamp 和 Workbook.sheetchange 使用 Excel VBA 创建数据历史记录 [英] Creating a data history with Excel VBA using LastRow, Time Stamp and Workbook.sheetchange

问题描述

我在 Excel VBA 中编写了一个手动宏，它显示了一个表格，以显示名为评估"的工作表中某些数据的历史记录.我引用的数据在清单"表中.(如下所示)问题是清单"中的数据每天或更频繁地变化.每次工作表更改时，宏都应在评估"表的 LastRow 中插入一个带有新日期的新行.(我用谷歌搜索，发现可以使用时间戳，见下文和函数 Workbook.Sheetchange，每次更改工作表时都应该激活这个宏，见下文).我想在评估"中显示数据的历史记录.所以最后一次更改的行中的值应该保持稳定.因此，例如评估"中的第 1 行:2020-01-17 值为 1(这应该保持为 1，因为我想查看进度)现在工作表更改并插入第 2 行:第 2 行:2020-01-18 值现在为 2(从清单复制)，我希望第 1 行中的值保持为 1(因为在上次更改之前它是 1).现在它看起来像这样:

子测试()'' 测试宏范围(A3").选择ActiveCell.FormulaR1C1 = "=NOW()"范围(B3").选择ActiveCell.FormulaR1C1 = "='清单'!R[399]C[58]"范围(C3").选择ActiveCell.FormulaR1C1 = "1"范围(D3").选择ActiveCell.FormulaR1C1 = "='清单'!R[399]C[58]"结束子

时间戳:

Private Sub Worksheet_Change(ByVal Target As Range)If Not Intersect(Target, Range("'checklist'!BH400:BL500")) 什么都没有单元格(Target.Row，1)= 格式(现在，DD/MM/YYYY hh:mm")万一结束子

workbook.sheetchange:

Private Sub Workbook_SheetChange(ByVal Sh As Object, _ByVal 源作为范围)' 在工作表更改时运行结束子

您对如何连接这些代码有任何想法吗?对不起，我不是真正的 VBA 专家.我制作了一个谷歌表来显示我的实际意思，但我在 excel VBA 中需要这个，谷歌表只是为了可视化我的意思:https://docs.google.com/spreadsheets/d/1OU_95Lhf6p0ju2TLlz8xmTegHpzTYu4DW0_X57mObBc/edit#gid=0p>

这是我现在的代码:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)If Sh.Name = "Checklist" Then'从 A3:E100 监控，如果不同，请更改此项If Not Intersect(target, Range("A2:E1000")) 是 Nothing Then'如果这里有监控，请在此处添加测试目标 '这里要插入的程序万一万一结束子私人子测试(目标为范围)将 LastRow 变暗LastRow = Range("Evaluation!A" & Sheets("Evaluation").Rows.Count).End(xlUp).RowIf Range("Evaluation!A1").Value <>"然后最后一行 = 最后一行 + 1万一'清单中的每个更改 A3:E 都会在此评估中插入行'但如果不同请你在这里决定Range("Evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") '你可以改变这个Range("Evaluation!B" & LastRow & ":F" & LastRow).Value = Range("Checklist!A" & target.Row & ":E" & target.Row).Value结束子

解决方案

这里监控CheckList!A1:H4，将CheckList!J3:N5全部复制到A列的Evaluation空行:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)如果 Sh.Name = "CheckList" 那么'从 CheckList 监控！A1:H4，如果不同，请更改此If Not Intersect(target, Range("CheckList!A1:H4")) 是 Nothing Then测试目标 '这里要插入的过程万一万一结束子私人子测试(目标为范围)将 LastRow 变暗将 myCol 调暗将 myRow 变暗myCol = target.Column如果 myCol >= 1 并且 myCol <= 8 那么If Range("Evaluation!A1") = "" Then Range("Evaluation!A1") = "History"If Range("Evaluation!A2") = "" Then Range("Evaluation!A2") = "Date"LastRow = Range("Evaluation!A" & Sheets("Evaluation").Rows.Count).End(xlUp).Row'在这种情况下，所有 J3 到 N5 都将被复制'如果不同，请修改为实际范围将 myRange 调暗为范围设置 myRange = Range("CheckList!J3:N5")对于 a = 1 到 myRange.Rows.Count最后一行 = 最后一行 + 1Range("Evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm")Range("Evaluation!B" & LastRow & ":F" & LastRow).Value = myRange.Rows(a).Value下一个万一结束子

I have programmed a manual macro in Excel VBA that displays a table 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 googled and I found the possibility to use a Timestamp, see below and the function Workbook.Sheetchange, that should activate this macro every time the worksheet gets changed, see below). 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). Right now it looks like this:

Sub Test()
'
' Test Macro
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "='checklist'!R[399]C[58]"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "='checklist'!R[399]C[58]"

End Sub

timestamp:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("'checklist'!BH400:BL500")) Is Nothing Then
      Cells(Target.Row, 1) = Format(Now, "DD/MM/YYYY  hh:mm")
   End If
End Sub

workbook.sheetchange:

Private Sub Workbook_SheetChange(ByVal Sh As Object, _ 
 ByVal Source As Range) 
 ' runs when a sheet is changed 
End Sub

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

THis is my code right now:

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("A2:E1000")) 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

解决方案

Here to monitor CheckList!A1:H4 and copy CheckList!J3:N5 to Evaluation empty row of Column A entirely:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "CheckList" Then
          'Monitoring from CheckList!A1:H4, if different change this

          If Not Intersect(target, Range("CheckList!A1:H4")) Is Nothing Then
             Test target 'Here procedure to insert
          End If
    End If
End Sub


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

    Dim myCol As Long
    Dim myRow As Long
    myCol = target.Column

    If myCol >= 1 And myCol <= 8 Then
    If Range("Evaluation!A1") = "" Then Range("Evaluation!A1") = "History"
    If Range("Evaluation!A2") = "" Then Range("Evaluation!A2") = "Date"
        LastRow = Range("Evaluation!A" & Sheets("Evaluation").Rows.Count).End(xlUp).Row

        'In this situation, all J3 to N5 will be copied
        'if different, please modify as actual range
        Dim myRange As Range
        Set myRange = Range("CheckList!J3:N5")
        For a = 1 To myRange.Rows.Count
            LastRow = LastRow + 1
            Range("Evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm")
            Range("Evaluation!B" & LastRow & ":F" & LastRow).Value = myRange.Rows(a).Value
        Next a
    End If
End Sub

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