excel - 使用 LastRow、Time Stamp 和 Workbook.sheetchange 使用 Excel VBA 创建数据历史记录
问题描述
我在 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 专家。我制作了一个谷歌表来显示我的实际意思,但我在 excel VBA 中需要这个,谷歌表只是为了形象化我的意思:https ://docs.google.com/spreadsheets/d/1OU_95Lhf6p0ju2TLlz8xmTegHpzTYu4DW0_X57mObBc/edit#gid =0
这是我现在的代码:
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
If Not Intersect(target, Range("BH400:BL500")) Is Nothing Then
Cells(target.Row, 1) = Format(Now, "DD/MM/YYYY hh:mm")
Test target
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
Range("evaluation!A" +LastRow).Value = "=NOW()"
Range("evaluation!B" +LastRow).Value = Range("CheckList!B" & Target.row)
Range("evaluation!C" +LastRow).Value= "1"
Range("evaluation!D" +LastRow).Value= Range("CheckList!D" & Target.row)
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("A3:E100")) 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 A3:E100, if different change this
If Not Intersect(target, Range("A3:E100")) 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:K100")) 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
Dim myCol As Long
myCol = target.Column
If myCol >= 1 And myCol <= 5 Then
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 If
If myCol >= 7 And myCol <= 11 Then
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 If
End Sub
推荐阅读
- datadog - 在 Datadog 的仪表板中显示服务的版本
- ruby - 是否有任何真实世界的字体在 CFF 表的顶部字典中指定编码?
- regex - semver 正则表达式比这个更便携或额外覆盖?
- android - Firebase 在父级观察/查询并忽略其中一个子级
- dart - 如何在 Flutter 中移除 AppBar 前导图标周围的额外填充
- python-2.7 - 面对 StaleElementReferenceException:消息:元素不再是有效的问题。请检查是否有出路
- python-3.x - 使用 selenium 在 python3 中执行 javascript 代码时出错
- java - 您可以从 jsp 文件中 <% %> 块中的 servlet 获取会话属性吗?
- windows - 如何在保留其所有配置文件的同时在同级目录中运行可执行文件?
- r - 减少 R 代码的运行时间