Создать историю журнала для изменения значения ячейки в столбце

Question

Я создаю рабочую таблицу журнала и сохраняю детали изменения других рабочих таблиц.

Dim oldValue As Variant

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sSheetName As String
sSheetName = "Data"
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & "-" & Target.Address(0, 0)
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = oldValue
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Formula
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Environ("username")
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Now

Sheets("LogDetails").Columns("A:D").AutoFit
Application.EnableEvents = True
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
oldValue = Target.Formula
End Sub

Это работает для отдельной ячейки, например:

Если A1 хранит «ABC» и изменяетв «123», Log Detail сохранит адрес ячейки, старое значение, новое значение, имя пользователя и дату / время.

Большая проблема, когда я выбираю целый столбец, например весь столбец (B),Будет выдано сообщение об ошибке

«тип не совпадает».

Я знаю, что проблема

oldValue = Target.Value

Как сохранить изменениестолбец?

Answer 1

Я не совсем уверен, решит ли это вашу проблему, но попробуйте следующую модификацию вашей Workbook_SheetSelectionChange процедуры:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Count > 1 Then
        Target(1).Select
        Exit Sub
    End If
    oldValue = Target.Value
    oldAddress = Target.Address
End Sub

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

Это должно значительно усложнить среднему пользователю намеренную или случайную модификацию более чем одной ячейки за раз.

---

Чтобы ответить на вопросы из ваших комментариев:

нельзя использовать функцию отмены Excel

Это правда.Excel не знает, как отменить действия, предпринятые вашим кодом.Вы должны построить эту функциональность самостоятельно. См. Этот вопрос + принятый ответ .

Показатель изменения формулы в журнале не может отображаться правильно, он будет отображать 0 или #Value!

Да, это по замыслу.В строке

Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Formula

вы указываете Excel установить значение этой ячейки в формулу.Какой Excel затем автоматически пытается оценить.(Это приводит к ошибкам, с которыми вы сталкиваетесь)
Попробуйте выполнить следующее:

' Prepend the formula with an apostrophe
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = "'" & Target.Formula

Это заставит Excel воспринимать значение ячейки как текст и, таким образом, будет просто отображать формулу без ее оценки.

копирование и вставка диапазона показывают только первые изменения ячейки, это не может быть исправлено?

Это связано с тем, что oldValues является массивом, а вы только когда-либо обращаетесьего первое значение.См. Мою реализацию:

Option Explicit

Dim oldValues As Variant

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Const LogSheet As String = "LogDetails"

    If Sh.Name = LogSheet Then Exit Sub

    Application.EnableEvents = False

    With Worksheets(LogSheet)

        Dim idxRows As Long
        For idxRows = 1 To Target.Rows.Count

            Dim idxCols As Long
            For idxCols = 1 To Target.Columns.Count

                Dim ChangedCell As Range
                Set ChangedCell = Target.Rows(idxRows).Columns(idxCols)

                Dim LogRow As Long
                LogRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                Dim LogRange As Range
                Set LogRange = .Range(.Cells(LogRow, 1), .Cells(LogRow, 5))

                LogRange(1).Value = Sh.Name & "!" & ChangedCell.Address(False, False)
                LogRange(2).Value = "'" & oldValues(idxRows, idxCols) ' error here when pasting a range of different size than has been selected before pasting
                LogRange(3).Value = ChangedCell.Formula
                LogRange(4).Value = Environ("username")
                LogRange(5).Value = Now

            Next idxCols

        Next idxRows

        .Columns("A:E").AutoFit

    End With

    Application.EnableEvents = True

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    oldValues = Target.Formula
End Sub

У этого недостатка есть то, что когда пользователь копирует несколько ячеек, а затем выбирает одну ячейку и вставляет, он выдаст ошибку из-за несовпадения индексов.(Это работает, когда вы копируете, например, 3 ячейки подряд, затем выбираете 3 другие ячейки подряд и вставляете.) Не знаете, как этого избежать.Нам необходимо зафиксировать размер вставленного диапазона, чтобы обновить oldValues соответственно.Поскольку Excel не предоставляет событие Workbook_SheetBeforePaste, это выглядит довольно сложно.