使用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). 现在看起来像这样:

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

时间戳:

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

您对如何连接这些代码有任何想法吗?抱歉，我不是VBA专家.我制作了一个Google工作表来显示我的实际意思，但是我需要在excel VBA中使用它，而Google工作表只是为了可视化我的意思:

解决方案

这里监视CheckList！A1:H4并将CheckList！J3:N5复制到A列的评估空行中:

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

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屋！