Question

我正在尝试在Excel工作表上创建VBA代码，我可以自动插入创建的日期（一旦插入数据）和更新日期（一旦行的任何单元格值从前一个值更改）。我尝试了下面的代码，我可以获得创建日期，但不是更新日期。

我收到此错误

类型不匹配

就行：

If Cells(Target.Row, i).Value <> PrevVal(Target.Row, i) Then

我想问题是我不知道如何正确捕获单元格的先前值，以便将其与新值进行比较。

供参考：我的表格如下：

Id  Position1   Position2   DATE Created    Date updated    Data1   Data2 ....

Dim PrevVal As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ExitGraceFully
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
    ExitGraceFully:
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("B:B"), Target) Is Nothing Or Not 
        Intersect(Range("C:C"), Target) Is Nothing Then

        Cells(Target.Row, 1).Value = Cells(Target.Row, 2) & Cells(Target.Row, 3)

        If Cells(Target.Row, 4).Value = "" Then
            Cells(Target.Row, 4).Value = Date & " " & Time
            Cells(Target.Row, 4).NumberFormat = "m/d/yyyy h:mm AM/PM"
        End If
    End If

    Dim i As Integer
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        For i = 2 To 50
            If Cells(Target.Row, i).Value <> PrevVal(Target.Row, i) Then
                Cells(Target.Row, 5).Value = Date & " " & Time
                Cells(Target.Row, 5).NumberFormat = "m/d/yyyy h:mm AM/PM"
            End If
        Next i
    End If
End Sub

Answer 1

我终于纠正了我的代码，现在它运行良好。

Dim PrevVal As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    On Error GoTo ExitGraceFully
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Target.Value
    Else
        PrevVal = Target
    End If
ExitGraceFully:
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("B:C"), Target) Is Nothing Then

    Cells(Target.Row, 1).Value = Cells(Target.Row, 2) & Cells(Target.Row, 3)

If Cells(Target.Row, 4).Value = "" Then
Cells(Target.Row, 4).Value = Date & " " & Time
Cells(Target.Row, 4).NumberFormat = "m/d/yyyy h:mm AM/PM"
End If
End If


If Not Intersect(Range("F:Z"), Target) Is Nothing Then
Application.EnableEvents = False
If (PrevVal <> "") And (Cells(Target.Row, Target.Column).Value <> PrevVal) Then
Cells(Target.Row, 5).Value = Date & " " & Time
Cells(Target.Row, 5).NumberFormat = "m/d/yyyy h:mm AM/PM"
End If

End If
Application.EnableEvents = True

End Sub

Answer 2

非常感谢@userZZZ，这正是我想要的！我根据您的要求调整了代码，并添加了另一个约束来在删除单元格内容时也更改日期。我注意到该代码仅适用于单个单元格，不适用于多个单元格。我可能会在那个时候进行工作，但是现在就足够了。

编辑：我添加了一次操作多个单元格并更新所有相应行的日期的可能性。但是，它仍然无法复制/粘贴多个单元格。为此，我添加了一条错误消息。另外，只需在第一个函数的开头添加“ Application.CutCopyMode = False”，即可简单地禁用复制/粘贴模式。

    Dim PrevVal As Variant
    Dim Block_rows As Integer
    Dim Date_column As Integer

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        On Error GoTo ExitGracefully

        If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
            PrevVal = Target.Value
        Else
            PrevVal = Target
        End If
    ExitGracefully:
    End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
        Date_column = 9
        Block_rows = 8

        On Error GoTo ErrorMessage

        'Select and change single cell
        If Not Intersect(Range("A:H"), Target) Is Nothing And Target.Row > Block_rows Then
            Application.EnableEvents = False
            If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
                'Update date if value changes or is deleted
                If (Cells(Target.Row, Target.Column).Value <> PrevVal) Or _
                (Cells(Target.Row, Target.Column).Value = 0 And PrevVal <> 0) Then
                    Cells(Target.Row, Date_column).Value = Date
                    Cells(Target.Row, Date_column).NumberFormat = "dd-mmm-yyyy"
                End If

            'Select multiple cells, but only change single cells
            ElseIf (Cells(Target.Row, Target.Column).Value <> PrevVal(Target.Row - Selection.Row + 1, Target.Column - Selection.Column + 1)) And _
            (Cells(Target.Row, Target.Column).Value <> 0) Then
                Cells(Target.Row, Date_column).Value = Date
                Cells(Target.Row, Date_column).NumberFormat = "dd-mmm-yyyy"

            'Delete multiple cells at once
            Else
                For RCount = 0 To Target.Rows.Count - 1
                    For CCount = 0 To Target.Columns.Count - 1
                        'Blank rows
                        If (Cells(Target.Row + RCount, Target.Column).Value = 0 And PrevVal(RCount + 1, CCount + 1) = 0) Then

                        'Delete cells or rows
                        ElseIf (Cells(Target.Row + RCount, Target.Column).Value = 0 And PrevVal(RCount + 1, CCount + 1) <> 0) Then
                            Cells(Target.Row + RCount, Date_column).Value = Date
                            Cells(Target.Row + RCount, Date_column).NumberFormat = "dd-mmm-yyyy"
                        End If
                    Next CCount
                Next RCount
            End If
        End If

        Application.EnableEvents = True
        Exit Sub

    ErrorMessage:
        MsgBox ("This function is not supported for the automatic update of the date.")
        Resume Next

    End Sub

如何自动将行创建日期和更新日期（一行中的任何单元格）存储到单独的单元格中？

2 个答案: