Excel'de değiştirilen bir hücrenin önceki değerini nasıl hatırlarsınız veya kaydedersiniz?

Normalde, bir hücreyi yeni içerikle güncellediğinizde, önceki değer Excel'de işlemi geri almadığınız sürece üzerine yazılır. Ancak, önceki değeri güncellenenle karşılaştırmak için saklamak istiyorsanız, önceki hücre değerini başka bir hücreye veya hücre yorumuna kaydetmek iyi bir seçenek olacaktır. Bu makaledeki yöntem size bunu başarmada yardımcı olacaktır.

Excel'de VBA kodu ile önceki hücre değerini kaydetme

Excel'de VBA kodu ile önceki hücre değerini kaydetme

Aşağıdaki ekran görüntüsünde gösterildiği gibi bir tablonuz olduğunu varsayalım. Eğer C sütunundaki herhangi bir hücre değişirse, önceki değerini G sütunundaki ilgili hücreye veya otomatik olarak bir yorum olarak kaydetmek isteyebilirsiniz. Bunu gerçekleştirmek için lütfen aşağıdaki adımları izleyin.

1. Güncellenirken kaydetmek istediğiniz değerleri içeren çalışma sayfasında, sayfa sekmesine sağ tıklayın ve açılan menüden "Kod Görünümü" seçeneğini seçin. Ekran görüntüsüne bakın:

2. Açılan "Microsoft Visual Basic for Applications" penceresinde, aşağıdaki VBA kodunu Kod penceresine kopyalayın.

Aşağıdaki VBA kodu, belirli bir sütunun önceki hücre değerini başka bir sütuna kaydetmenize yardımcı olur.

VBA kodu: Önceki hücre değerini başka bir sütun hücresine kaydetme

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

Önceki hücre değerini bir yoruma kaydetmek için lütfen aşağıdaki VBA kodunu uygulayın.

VBA kodu: Önceki hücre değerini yoruma kaydetme

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

Not: Kodda, 7 sayısı, önceki hücre değerini kaydedeceğiniz G sütununu temsil eder ve C:C ise değişiklik yapacağınız sütundur. Lütfen bunları ihtiyaçlarınıza göre değiştirin.

3. "Araçlar" > "Referanslar" seçeneğine tıklayarak "Referanslar – VBAProject" iletişim kutusunu açın, "Microsoft Scripting Runtime" kutucuğunu işaretleyin ve son olarak "Tamam" düğmesine tıklayın. Ekran görüntüsüne bakın:

4. "Microsoft Visual Basic for Applications" penceresini kapatmak için "Alt" + "Q" tuşlarına basın.

Artık, C sütunundaki bir hücre değeri güncellendiğinde, önceki değer ilgili hücredeki G sütununda veya bir yorum olarak kaydedilecektir, aşağıdaki ekran görüntülerinde gösterildiği gibi.

Önceki hücre değerlerini diğer hücrelerde kaydetme:

Önceki hücre değerlerini yorumlarda kaydetme: