VBA - автоматическая отметка времени, срабатывающая при удалении данных и смене фильтра - PullRequest
2 голосов
/ 24 мая 2019

Я просто хотел бы добавить автоматическую отметку времени в Excel.

Не могли бы вы сообщить о 2 проблемах, с которыми я столкнулся при использовании таблицы для массовой вставки / удаления

1, После удаления нескольких строк отметка времени все еще остается там, предпочла бы, чтобы она была удалена

2, при многострочной вставке / удалении отметка времени переходит в ошибку, заранее спасибо

Заранее спасибо

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myTableRange As Range, TargetVal As String
Set myTableRange = Range("C2:Y1048576") 'Change to your range..
If Intersect(Target, myTableRange) Is Nothing Then Exit Sub

With Application
.ScreenUpdating = False
.EnableEvents = False
.Undo
TargetVal = Target.Value
.Undo
If Target.Value <> TargetVal Then

'Your Code doing something with timestamp
Set myDateTimeRange = Range("A" & Target.Row)

'Column for last updated date/time
Set myUpdatedRange = Range("B" & Target.Row)

'Set Time Stamp Value
myDateTimeRange.Value = Format(Now)

'Column for last updated date/time
 myUpdatedRange.Value = Format(Now)

    Debug.Print Target.Value
End If
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

1 Ответ

0 голосов
/ 24 мая 2019

Как насчет этого:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myTableRange As Range, IntSectRange As Range, TargetVal As String
Set myTableRange = Range("A2:B" & Cells(Rows.Count, 2).End(xlUp).Row) 'Change to your range..
Set IntSectRange = Intersect(Target, myTableRange)
If IntSectRange Is Nothing Then
    Exit Sub
Else
    If IntSectRange.Cells.Count = 1 Then 'Thus when only one cell gets changed
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Undo
            TargetVal = Target.Value
            .Undo
            If Target.Value <> TargetVal Then
                'Your Code doing something with timestamp
                Debug.Print Target.Value
            End If
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    Else 'Thus when there are more cells involved (bulk)
        'Your Code doing something with timestamp
    End If
End If

End Sub

Код сначала проверяет, пересекается ли диапазон, если это так, отменяет последнее действие пользователя, проверяет его значение, повторяет действие пользователя и проверяет, было ли введено новое значение.или удаленное значение.

Возможно, вы захотите добавить еще один тест для строк (динамический myTableRange), если пользователь удалит сразу всю строку, что приведет к ошибке.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...