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 Sub

Chú 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: