【问题标题】:Create log history for a cell value change in a column为列中的单元格值更改创建日志历史记录
【发布时间】:2019-04-23 20:25:14
【问题描述】:

我创建了一个日志历史工作表并保存其他工作表的更改详细信息。

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 将保存 Cell 地址、旧值、新值、用户名和日期/时间。

最大的问题是当我选择一整列时,例如所有列(B)。会报错

“类型不匹配”。

我知道问题出在

oldValue = Target.Value

如何保存对列的更改?

【问题讨论】:

  • 你想要发生什么?我不太明白“它也可以保存列的更改”。是否要记录选择更改?用户不容易修改多个单元格,除了复制+粘贴。 The issue with oldValue = Target.Value is that when multiple cells are selected, Target.Value will return an array, which you can't store in a simple string variable.因此类型不匹配。所以你需要决定在多单元格选择的情况下你到底想要发生什么?也许强制选择仅第一个单元格?
  • 还要考虑同时记录多个更改的含义:是否应该单独记录列的所有单元格中的更改(因此 1048576 更改)?您的日志表将立即填满。还是您想以某种方式将这些更改压缩到更少的行中? (怎么会?)
  • 抱歉回复晚了,我想做的是,例如,如果我改变范围(“A1”)公式:=C1+D1,然后选择一个范围,如 A1-A20然后 Ctrl+D 将公式替换为整个选择。在我看来,记录应该显示 2 记录。第一个是我替换 A1 范围内的公式第二个是我替换 A2-A20 范围内的公式,但我不知道如何显示它....
  • 我第一次做这个 vba 是我希望列的所有单元格中的更改将被自己记录,我知道这将立即被填满。但我的工作簿文件有时会获得更多 2000 条记录。这将是一个漫长而漫长的过程,所以如果可能的话,将在其中显示 2 条记录。
  • 还有一个问题是,当我更改单元格的公式并记录它时。 logdetail 只显示值的变化,而不是公式的变化。(我希望它在目标中显示 =A1+B1 。值,类似的东西)。可以改变显示格式吗?

标签: excel vba


【解决方案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

每次用户选择多个单元格时,事件过程都会更改该选择(这会引发另一个更改事件,这次只有一个单元格目标)并退出而不做任何其他事情。当然,可以细化何时应该发生这种选择变化的标准,以允许更具体的行为。

这将使普通用户一次有意或无意地修改多个单元格变得更加困难。


解决您的 cmets 的问题:

不能使用excel的undo功能

这是真的。 Excel 不知道如何撤销您的代码已执行的操作。您需要自己构建此功能。 See this question + accepted answer.

日志表中显示的公式更改无法正确显示,它将显示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 事件,这似乎相当棘手。

【讨论】:

  • 抱歉@Inarion 回复晚了,这两天我有任务,真的很抱歉迟到了。我已经测试了您的代码,但是当我在黑色单元格中输入内容时,它会显示错误。 “类型不匹配”,这是怎么回事?
  • @Nicawong9147 我不确定单元格的颜色与这些有什么关系?你能确定那个细胞没有其他可能是罪魁祸首的属性吗?
  • 抱歉,输入错误,应该是空白单元格,而不是黑色单元格。我将您的代码放入 Thisworkbook 并构建 LogDetails 表。无论我在 Sheet1、Sheet2 或 Sheet3 中输入什么,只要显示类型不匹配即可。
  • 此代码中显示的错误代码:LogRange(2).Value = "'" & oldValues(idxRows, idxCols)
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2017-01-06
  • 1970-01-01
  • 2021-03-17
  • 2020-02-13
  • 1970-01-01
相关资源
最近更新 更多