Làm cách nào để nhớ hoặc lưu giá trị ô trước đó của một ô đã thay đổi trong Excel?
Thông thường, khi cập nhật ô có nội dung mới, giá trị trước đó sẽ bị che trừ khi hoàn tác thao tác trong Excel. Tuy nhiên, nếu bạn muốn giữ giá trị trước đó để so sánh với giá trị đã cập nhật, lưu giá trị ô trước đó vào một ô khác hoặc vào nhận xét ô sẽ là một lựa chọn tốt. Phương pháp trong bài viết này sẽ giúp bạn đạt được điều đó.
Lưu giá trị ô trước đó bằng mã VBA trong Excel
Lưu giá trị ô trước đó bằng mã VBA trong Excel
Giả sử bạn có một bảng như ảnh chụp màn hình bên dưới. Nếu bất kỳ ô nào trong cột C thay đổi, bạn muốn lưu giá trị trước đó của nó vào ô tương ứng của cột G hoặc tự động lưu trong nhận xét. Hãy làm như sau để đạt được nó.
1. Trong trang tính có chứa giá trị bạn sẽ lưu khi cập nhật, hãy nhấp chuột phải vào tab trang tính và chọn Mã Chế độ xem từ menu chuột phải. Xem ảnh chụp màn hình:
2. Trong phần mở đầu Microsoft Visual Basic cho các ứng dụng cửa sổ, sao chép mã VBA bên dưới vào cửa sổ Mã.
Mã VBA sau đây giúp bạn lưu giá trị ô trước đó của cột được chỉ định vào một cột khác.
Mã VBA: Lưu giá trị ô trước đó vào một ô cột khác
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Để lưu giá trị ô trước đó trong nhận xét, vui lòng áp dụng mã VBA bên dưới
Mã VBA: Lưu giá trị ô trước đó trong nhận xét
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 SubChú thích: Trong mã, số 7 cho biết cột G bạn sẽ lưu ô trước đó vào và C: C là cột bạn sẽ lưu giá trị ô trước đó. Vui lòng thay đổi chúng dựa trên nhu cầu của bạn.
3. nhấp chuột CÔNG CỤ > dự án để mở Giới thiệu - VBAProject hộp thoại, kiểm tra Thời gian chạy tập lệnh của Microsoft và cuối cùng nhấp vào OK cái nút. Xem ảnh chụp màn hình:
4. Nhấn nút Khác + Q chìa khóa để đóng Microsoft Visual Basic cho các ứng dụng cửa sổ.
Kể từ bây giờ, khi giá trị ô trong cột C được cập nhật, giá trị trước đó của ô sẽ được lưu vào các ô tương ứng trong cột G hoặc lưu trong nhận xét như ảnh chụp màn hình bên dưới.
Lưu các giá trị ô trước đó trong các ô khác:
Lưu các giá trị ô trước đó trong nhận xét:
Công cụ năng suất văn phòng tốt nhất
Nâng cao kỹ năng Excel của bạn với Kutools for Excel và trải nghiệm hiệu quả hơn bao giờ hết. Kutools for Excel cung cấp hơn 300 tính năng nâng cao để tăng năng suất và tiết kiệm thời gian. Bấm vào đây để có được tính năng bạn cần nhất...
Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều
- Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
- Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
- Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
