VBA在特定列中logging行更改的date
我试图自动更新Excel电子表格的“更新”列，当该特定行的任何单元格更改为今天的date。 我能够通过硬编码“更新”列标题的位置来实现这一点，但是，现在有必要在列标题移动时search该列标题。
我试图实现的代码工作，但立即给我的错误Automation error - The object invoked has disconnected from it's clients.
任何帮助，将不胜感激。 这是我目前的代码：
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:DX")) Is Nothing Then Dim f As Range Set f = ActiveSheet.Range("A1:DD1").Find("Updated", lookat:=xlWhole) ' f.Row = Range(Target).Row If Not f Is Nothing Then Range(Split(f.Address, "$")(1) & Target.Row).Value = Now Else MsgBox "'Updated' header not found!" End If End If End Sub
你进入了一个无限循环。 尝试这个：
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:DX")) Is Nothing Then Dim f As Range Set f = ActiveSheet.Range("A1:DD1").Find("Updated", lookat:=xlWhole) ' f.Row = Range(Target).Row If f Is Nothing Then MsgBox "'Updated' header not found!" ElseIf Intersect(Target, f.EntireColumn) Is Nothing Then Intersect(Target.EntireRow, f.EntireColumn).Value = Now ' Else ' MsgBox "We entered this function again because the row above updated the Updated column", vbInformation, "False alarm" End If End If End Sub
为了理解发生了什么，
- 取消注释else和MsgBox
- 在MsgBox上放置一个断点
- 当你点击它时，按
[ctrl]-L
在这种情况下，当我简单地遍历可用的单元格以查找列标题时，遇到的问题就less得多了。 使用.Find方法也可以，但在自定义应用程序中不太“可调”。
Public Function FindColumn(header As String) As Long Dim lastCol As Long Dim headerCol As Long Dim i As Long Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("VTO2 Labor") lastCol = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column headerCol = 0 For i = 1 To lastCol If sh.Cells(1, i).Value = header Then headerCol = i End If Next i FindColumn = headerCol End Function
不清楚更新的列标题是否可以在第1行，或者它是否总是在第1行，只是不在同一个位置。
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:DX")) Is Nothing Then On Error GoTo bm_SafeExit 'TURN OFF EVENTS IF YOU ARE GOING TO WRITE A VALUE INTO THE WORKSHEET! Application.EnableEvents = False Dim uCol As Long, f As Range If Application.CountIf(Rows(1), "updated") Then uCol = Application.Match("updated", Rows(1), 0) For Each f In Intersect(Target, Range("A:DX")) If f.Row > 1 Then _ Cells(f.Row, uCol) = Now Next f Else MsgBox "'Updated' header not found!" End If End If bm_SafeExit: Application.EnableEvents = True End Sub
这应该存在多个更新（例如，当粘贴值时）。 我看到的问题是更新的列正在转移，大概是通过插入列或类似的东西，然后更改例程将运行。