Обновите ячейку excel с датой, если ячейка в диапазоне обновлена

Мне нужно обновить ячейку с отметкой даты и времени (СЕЙЧАС()), если какая-либо ячейка обновляется в любой ячейке перед ней в той же строке.

Поэтому обновите ячейку «CU» с датой и временем, когда любая ячейка из «A-CR» будет обновлена.

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

В настоящее время у меня есть некоторый Vba, который делает что-то подобное, обновляя соседнюю ячейку с указанием времени и даты, что требуется, но мне также нужен общий для всего процесса.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, AE:AE, AH:AH, AK:AK, AN:AN, AQ:AQ, AT:AT, AW:AW, AZ:AZ, BC:BC, BF:BF, BI:BI, BL:BL, BO:BO, BR:BR, BU:BU, BX:BX, CA:CA, CD:CD, CG:CG, CJ:CJ, CM:CM, CP:CP")) Is Nothing Then
    On Error GoTo safe_exit
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        Dim trgt As Range, ws1 As Worksheet
        'Set ws1 = ThisWorkbook.Worksheets("Info")
        For Each trgt In Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, AE:AE, AH:AH, AK:AK, AN:AN, AQ:AQ, AT:AT, AW:AW, AZ:AZ, BC:BC, BF:BF, BI:BI, BL:BL, BO:BO, BR:BR, BU:BU, BX:BX, CA:CA, CD:CD, CG:CG, CJ:CJ, CM:CM, CP:CP"))
            If trgt <> vbNullString Then
                If UCase(trgt.Value) = "Y" Or UCase(trgt.Value) = "N" Then
                    Cells(trgt.Row, trgt.Column + 1) = Now()
                    Cells(trgt.Row, trgt.Column + 2) = Environ("username")
                    'Select Case trgt.Column
                    '    Case 2   'column B
                    '        Cells(trgt.Row, trgt.Column + 1) = Environ("username")

                    '     Case 4   'column D
                    '       'do something else
                    ' End Select
                Else
                    trgt = ""
                    Cells(trgt.Row, trgt.Column + 1) = ""
                    Cells(trgt.Row, trgt.Column + 2) = ""
                End If
            End If

        Next trgt
        'Set ws1 = Nothing
    End With
End If

безопасный_выход: Приложение.EnableEvents = Истина Application.ScreenUpdating = Истина Конец сабвуфера

Найдите событие рабочего листа Worksheet_Change это то, что вам нужно,

— 29.05.2019 11:29

привет, замени для каждого trgt In Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, .... с For Each trgt In Target..

— 29.05.2019 11:47

excel vba excel-formula

29.05.2019 11:26

Преобразование HTML-таблицы в профессиональный документ Excel

Это самый простой способ создания Excel из HTML-таблицы.

Импорт excel в laravel в базу данных

Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...

294

Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Ответ принят как подходящий

Это работает для меня:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    If Intersect(Target, Me.Range("A" & Target.Row & ":CR" & Target.Row)) Is Nothing Then GoTo SafeExit
    Me.Cells(Target.Row, "CU") = Now()
SafeExit:
    Application.EnableEvents = True

End Sub

Брилл, это сработало, теперь просто нужно решить, как интегрировать его с моим текущим кодом выше.

— 29.05.2019 11:58

Я бы сделал If/ElseIF со всеми вашими потребностями и кодом между ними. Вне if Application.EnableEvents и это должно сделать это.

— 29.05.2019 11:59

29.05.2019 11:50

Приведенный ниже код заботится о:

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

Dim oldValue As String

'Change the range below where your data will be
Const RangeString = "A:CR"

'Below variable decides the column in which date will be displayed
'Change the below value to 1 for column A, 2 for B, ... 99 for CU
Const ColumnIndex = 99

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WorkRng As Range
    Dim HorizontalRng As Range
    Dim Rng As Range
    Dim HorRng As Range
    Dim RowHasVal As Boolean

    Set WorkRng = Intersect(ActiveSheet.Range(RangeString), Target)

    If Not WorkRng Is Nothing Then
        If WorkRng.Cells.Count = 1 And WorkRng.Cells(1, 1).Value = oldValue Then
            Exit Sub
        End If
        Application.EnableEvents = False
        For Each Rng In WorkRng
            Set HorizontalRng = Intersect(ActiveSheet.Range(RangeString), Rows(Rng.Row))
            RowHasVal = False
            For Each HorRng In HorizontalRng
                If Not VBA.IsEmpty(HorRng.Value) Then
                    RowHasVal = True
                    Exit For
                End If
            Next
            If Not RowHasVal Then
                ActiveSheet.Cells(Rng.Row, ColumnIndex).ClearContents
            ElseIf Not VBA.IsEmpty(Rng.Value) Then
                ActiveSheet.Cells(Rng.Row, ColumnIndex).Value = Now
                ActiveSheet.Cells(Rng.Row, ColumnIndex).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, ActiveSheet.Range(RangeString)) Is Nothing Then
        If Target.Cells.Count = 1 Then
            oldValue = Target.Value
        Else
            oldValue = ""
        End If
    End If
End Sub

22.02.2020 18:16

Другие вопросы по теме

Отказ от использования worksheet.activate для выполнения кода

Создание диапазона внутри databodyrange

Как я могу настроить сводную таблицу Excel для отображения только ранга 1 через VBA?

VBA: как автоматически включать границы ячеек без ошибки (время выполнения 1004) Стиль линии

Поиск пропущенных чисел в заданном диапазоне

Функция VBA для копирования текста из одной неподвижной ячейки для вставки в другую ячейку, перемещение вниз на одну ячейку при каждой вставке/цикле

Как выбрать вариант из выпадающего списка на веб-странице, используя внутренний текст

Нет разрешения на чтение «MSysObjects» (номер ошибки: -2147217911) при использовании Microsoft Excel VBA для запроса доступа только к файлам accdb — mdb работает нормально

EXCEL VBA: редактирование столбца строк с помощью функции

Цикл Excel VBA и интерактивное отображение изменений

Обновите ячейку excel с датой, если ячейка в диапазоне обновлена

Ответы 2

Другие вопросы по теме

Похожие вопросы