Как запомнить или сохранить предыдущее значение измененной ячейки в Excel?

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

Сохранение предыдущего значения ячейки с помощью кода VBA в Excel

Сохранение предыдущего значения ячейки с помощью кода VBA в Excel

Предположим, у вас есть таблица, как показано на скриншоте ниже. Если любая ячейка в столбце C изменяется, вы можете захотеть сохранить её предыдущее значение в соответствующей ячейке столбца G или автоматически добавить его как комментарий. Пожалуйста, следуйте инструкциям ниже, чтобы это реализовать.

1. На листе, содержащем значения, которые вы хотите сохранять при обновлении, щелкните правой кнопкой мыши по вкладке листа и выберите "Вид кода" из контекстного меню. См. скриншот:

2. В открывшемся окне "Microsoft Visual Basic for Applications" скопируйте приведенный ниже код VBA в окно Кода.

Следующий код VBA помогает сохранить предыдущее значение ячейки указанного столбца в другой столбец.

Код VBA: Сохранить предыдущее значение ячейки в другую ячейку столбца

Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xCell As Range
    Dim xDCell As Range
    Dim xHeader As String
    Dim xCommText As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    xHeader = "Previous value :"
    x = xDic.Keys
    For I = 0 To UBound(xDic.Keys)
        Set xCell = Range(xDic.Keys(I))
        Set xDCell = Cells(xCell.Row, 7)
        xDCell.Value = ""
        xDCell.Value = xDic.Items(I)
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim I, J As Long
    Dim xRgArea As Range
    On Error GoTo Label1
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Set xDependRg = Target.Dependents
    If xDependRg Is Nothing Then GoTo Label1
    If Not xDependRg Is Nothing Then
        Set xDependRg = Intersect(xDependRg, Range("C:C"))
    End If
Label1:
    Set xRg = Intersect(Target, Range("C:C"))
    If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = Union(xRg, xDependRg)
    ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = xDependRg
    ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
        Set xChangeRg = xRg
    Else
        Application.EnableEvents = True
        Exit Sub
    End If
    xDic.RemoveAll
    For I = 1 To xChangeRg.Areas.Count
        Set xRgArea = xChangeRg.Areas(I)
        For J = 1 To xRgArea.Count
            xDic.Add xRgArea(J).Address, xRgArea(J).Formula
        Next
    Next
    Set xChangeRg = Nothing
    Set xRg = Nothing
    Set xDependRg = Nothing
    Application.EnableEvents = True
End Sub

Для сохранения предыдущего значения ячейки в комментарии примените следующий код VBA.

Код VBA: Сохранить предыдущее значение ячейки в комментарии

Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xCell As Range
    Dim xHeader As String
    Dim xCommText As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    xHeader = "Previous value :"
    For I = 0 To UBound(xDic.Keys)
        Set xCell = Range(xDic.Keys(I))
        If Not xCell.Comment Is Nothing Then xCell.Comment.Delete
        With xCell
            .AddComment
            .Comment.Visible = False
            .Comment.Text xHeader & vbCrLf & xDic.Items(I)
        End With
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim I, J As Long
    Dim xRgArea As Range
    On Error GoTo Label1
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Set xDependRg = Target.Dependents
    If xDependRg Is Nothing Then GoTo Label1
    If Not xDependRg Is Nothing Then
        Set xDependRg = Intersect(xDependRg, Range("C:C"))
    End If
Label1:
    Set xRg = Intersect(Target, Range("C:C"))
    If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = Union(xRg, xDependRg)
    ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = xDependRg
    ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
        Set xChangeRg = xRg
    Else
        Application.EnableEvents = True
        Exit Sub
    End If
    xDic.RemoveAll
    For I = 1 To xChangeRg.Areas.Count
        Set xRgArea = xChangeRg.Areas(I)
        For J = 1 To xRgArea.Count
            xDic.Add xRgArea(J).Address, xRgArea(J).Text
        Next
    Next
    Set xChangeRg = Nothing
    Set xRg = Nothing
    Set xDependRg = Nothing
    Application.EnableEvents = True
End Sub

Примечание: В коде число 7 указывает на столбец G, куда вы сохраните предыдущее значение ячейки, а C:C — это столбец, в котором будут происходить изменения. Измените их в зависимости от ваших потребностей.

3. Нажмите "Инструменты" > "Ссылки", чтобы открыть диалоговое окно "Ссылки – VBAProject", отметьте галочкой "Microsoft Scripting Runtime" и нажмите кнопку "ОК". См. скриншот:

4. Нажмите клавиши "Alt" + "Q", чтобы закрыть окно "Microsoft Visual Basic for Applications".

Теперь, когда значение ячейки в столбце C обновляется, предыдущее значение будет сохранено в соответствующей ячейке столбца G или как комментарий, как показано на скриншотах ниже.

Сохранение предыдущих значений ячеек в других ячейках:

Сохранение предыдущих значений ячеек в комментариях: