Як запам'ятати або зберегти попереднє значення комірки зміненої комірки в Excel?
Зазвичай під час оновлення комірки новим вмістом попереднє значення буде покрито, якщо не скасовуєте операцію в Excel. Однак, якщо ви хочете зберегти попереднє значення для порівняння з оновленим, збереження попереднього значення комірки в іншій клітинці або в коментарі комірки буде хорошим вибором. Метод, описаний у цій статті, допоможе вам цього досягти.
Збережіть попереднє значення комірки за допомогою коду VBA в Excel
Збережіть попереднє значення комірки за допомогою коду VBA в Excel
Припустимо, у вас є таблиця, як показано нижче. Якщо будь-яка комірка в стовпці C змінилася, ви хочете зберегти її попереднє значення у відповідній комірці стовпця G або зберегти в коментарі автоматично. Будь ласка, виконайте наступне, щоб досягти цього.
1. На робочому аркуші міститься значення, яке ви збережете під час оновлення, клацніть правою кнопкою миші вкладку аркуша та виберіть Переглянути код з меню правої клавіші миші. Дивіться знімок екрана:
2. На відкритті Microsoft Visual Basic для додатків вікно, скопіюйте наведений нижче код 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. клацання Tools > посилання відкрити Довідкові матеріали - VBAProject діалогове вікно, перевірте Виконання сценаріїв Microsoft і нарешті клацніть на OK кнопку. Дивіться знімок екрана:
4 Натисніть кнопку інший + Q клавіші, щоб закрити Microsoft Visual Basic для додатків вікна.
Відтепер, коли значення комірки в стовпці C оновлено, попереднє значення комірки буде збережено у відповідні комірки в стовпці G або збережено в коментарі, як показано на скріншотах нижче.
Зберегти попередні значення клітинок в інших клітинках:
Зберегти попередні значення клітинок у коментарях:
Найкращі інструменти продуктивності офісу
Покращуйте свої навички Excel за допомогою Kutools для Excel і відчуйте ефективність, як ніколи раніше. Kutools для Excel пропонує понад 300 додаткових функцій для підвищення продуктивності та економії часу. Натисніть тут, щоб отримати функцію, яка вам найбільше потрібна...
Вкладка Office Передає інтерфейс із вкладками в Office і значно полегшує вашу роботу
- Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
- Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
- Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
