记录更改列中的单元格值[关闭]

Question

我有一列使用 VLOOKUP 从另一张表中引入值。每当单元格值发生更改时，我想将此列中任何单元格的先前值保存到下一列中的相应单元格。 示例： 当前值：单元格 A1=1，A2=2 如果 VLOOKUP 现在带来不同的值并且 A1 变为 2，则 A1 的旧值 1 应该在单元格 B1 中更新。 A列中的任何单元格也是如此。 由于此更改可能发生 4 到 5 次，因此我希望在发生更改时重复将旧值从 B 列复制到 E 列，以便记录所有以前的值。 我寻找了一些解决方案，发现了一些涉及 VBA 的解决方案，但它们只适用于单个单元格，而不是一行，或者没有办法重复跟踪几次。 感谢这方面的任何帮助。谢谢！

Answer 1

请测试下一个代码。它使用Worksheet_Calculate 事件。请复制工作表中要处理的代码模块中的下一个代码。

它首先在Static字典中加载要检查的范围（A：A填充范围）。如果您需要重置字典，只需在“F1”中写入“x”（不带双引号）就足够了。它将在下一个空列中填充先前的 VLOOKUP 公式值。如果“E”中的值已经存在，将插入一个新列并用于填充历史。该代码需要引用“Microsoft Scripting Runtime”：

Option Explicit


Private Sub Worksheet_Calculate()
  Static dict As New Scripting.Dictionary
  Dim rngA As Range, Cel As Range, lastRow As Long, arrHist, arrA, firstRow As Long
  Dim arr, lastCol As Long, i As Long, j As Long, arrNew, colLetter As String
  Dim rngMark As Range, markCol As Long, nrColHist As Long
  Const strMark As String = "Marker"
  
  firstRow = 6: colLetter = "C" 'define the column and start row of the range to be checked
  
  Set rngMark = Me.Range(colLetter & firstRow - 1).EntireRow.Find(What:=strMark, _
                                                LookIn:=xlValues, LookAt:=xlWhole)
  If Not rngMark Is Nothing Then
      markCol = rngMark.Column: nrColHist = markCol - Range(colLetter & 1).Column - 1
  Else
      MsgBox "No marked column has been found!" & vbCrLf & _
             "The fifth column after the one being checked must be marked.", vbInformation, _
             "Marked column missing": Exit Sub
  End If
  lastRow = Me.Range(colLetter & Me.rows.count).End(xlUp).row    'last row of the chosen column
  Set rngA = Me.Range(colLetter & firstRow & ":" & colLetter & lastRow)    'set the range to be checked
  arrHist = Me.Range(rngA.Offset(0, 1), rngA.Offset(0, nrColHist)).Value 'set the array of previous values
  arrA = rngA.Value
  
  'firstly load the range to be checked in the dictionary
  If dict.count = 0 Or UCase(Me.Range("F1")) = "X" Then 'if dict not loaded, or 'x' in cell "F1"
    dict.RemoveAll               'clear the dictionary
    For i = rngA.row To lastRow  'iterate between the real rows of the range to be checked
        dict.Add rngA.cells(i - rngA.row + 1, 1).Address, rngA.cells(i - rngA.row + 1, 1).Value 'load the dictionary
    Next i
    Me.Range("F1").ClearContents                        'clear contents in case of resetting using 'x'
    MsgBox "The dictionary has been loaded and updated..."
  Else
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
      For i = rngA.row To lastRow                            'iterate between the range to be checked rows
        If dict.Exists(Me.Range(colLetter & i).Address) Then 'if the cell address exist in dict
            lastCol = Me.cells(i, rngA.Column + nrColHist + 1).End(xlToLeft).Column 'calculate last filled column
            If lastCol = rngA.Column And Me.cells(i, rngA.Column + nrColHist).Value <> Empty Then 'when all history columns are filled
                If CStr(Me.cells(i, colLetter).Value) <> CStr(dict(Me.Range(colLetter & i).Address)) Then 'it acts only if value <> last dict item
                    rngMark.EntireColumn.Insert: lastCol = rngMark.Column - 1
                    Me.cells(i, lastCol).Value = dict(Me.Range(colLetter & i).Address)    ' take the value from dictionary
                    dict(Me.Range(colLetter & i).Address) = Me.Range(colLetter & i).Value 'update the dictionary item value
                End If
            Else                                                          'when not all 4 history columns are filled
                If CStr(Me.cells(i, colLetter).Value) <> CStr(dict(Me.Range(colLetter & i).Address)) Then 'it acts if val <> last array element
                    Me.cells(i, lastCol + 1).Value = dict(Me.Range(colLetter & i).Address) 'fill the last empty history cells
                    dict(Me.Range(colLetter & i).Address) = Me.Range(colLetter & i).Value  'update the dictionary item value
                End If
            End If
        Else
            dict.Add Me.Range(colLetter & i).Address, Me.Range(colLetter & i).Value        'in case of new formula added
        End If
      Next i
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
  End If
End Sub

众所周知：如果您的代码因错误而停止，您应该手动运行底部的Sub (EnableMeEvents)。代码停止计算，禁用事件并需要重新启用它们。

如果您不知道如何添加所需的引用，请使用下一个代码，在运行 main（上面的那个）之前，然后保存工作簿：

Sub addScrRunTimeRef()
  'Add a reference to 'Microsoft Scripting Runtime':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
End Sub

注意：

这个新版本如果历史次数超过 4 次更改，则插入一个新列，并用它来记录下一个历史数据。但它需要一个参考列。保留要检查的范围的列之后的第五列必须有一个标题才能被代码识别。上述事件使用“Mark”。它必须存在于标题行中。我的意思是，在firstRow 上方的那一行。您可以调整代码（strMark 常量）以保留您想要选择的任何此类标记。