Question

我试图自动更新＆＃34;更新＆＃34;当特定行的任何单元格更改为今天的日期时，Excel电子表格的列。我能够通过硬编码来实现这一点，其中＆＃34;更新＆＃34;但是，如果列标题可能会移动，则现在需要搜索该列标题。

我尝试实现的代码可以正常工作，但会立即给我错误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

这应该能够经受多次更新（例如粘贴值时）。我看到的问题是更新的列被移动，可能是通过插入列等，然后更改例程将运行。

VBA记录特定列中行更改的日期

3 个答案: