VBA在特定列中記錄行更改日期

Question

當該特定行的任何單元格更改為今天的日期時，我正在嘗試自動更新excel電子表格的“已更新”列。 我可以通過對“更新的”列標題所在的位置進行硬編碼來實現此目的，但是，現在必須搜索該列標題，因為它可能會移動。

我嘗試實現的代碼可以正常工作，但立即出現錯誤“ 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

Answer 1

您陷入了無盡的循環。 嘗試這個：

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

Answer 2

在這種情況下，當我簡單地遍歷可用單元格以查找列標題時，就會遇到更少的問題。 使用.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

Answer 3

目前尚不清楚該更新的列標題是否可以在第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

那應該在多次更新后仍然存在（例如，粘貼值時）。 我看到的問題是，Updated列正在移動，大概是通過插入列之類的東西，然后更改例程將要運行。