Как да запомните или запазите стойността на предишна клетка на променена клетка в 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. кликване Инструменти > Препратки за да отворите Препратки – VBAProject диалоговия прозорец, проверете Microsoft Scripting Runtime и накрая щракнете върху OK бутон. Вижте екранна снимка:
4. Натисни Друг + Q ключове за затваряне на Microsoft Visual Basic за приложения прозорец.
Отсега нататък, когато стойността на клетката в колона C се актуализира, предишната стойност на клетката ще бъде запазена в съответните клетки в колона G или ще бъде запазена в коментар, както е показано на екранните снимки по-долу.
Запазете стойностите на предишни клетки в други клетки:
Запазете стойностите на предишните клетки в коментарите:
Най-добрите инструменти за продуктивност в офиса
Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време. Щракнете тук, за да получите функцията, от която се нуждаете най-много...
Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна
- Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
- Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!
