使用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列的评估空行中: 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: timestamp: workbook.sheetchange: 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:
Here to monitor CheckList!A1:H4 and copy CheckList!J3:N5 to Evaluation empty row of Column A entirely:
这篇关于使用LastRow,Time Stamp和Workbook.sheetchange使用Excel VBA创建数据历史记录的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!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
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
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Source As Range)
' runs when a sheet is changed
End Sub
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
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