Excel'de değiştirilmiş bir hücrenin önceki hücre değeri nasıl hatırlanır veya kaydedilir?
Normalde, bir hücreyi yeni içerikle güncellerken, Excel'de işlem geri alınmadıkça önceki değer kapsanacaktır. Ancak, güncellenen ile karşılaştırmak için önceki değeri korumak istiyorsanız, önceki hücre değerini başka bir hücreye veya hücre yorumuna kaydetmek iyi bir seçim olacaktır. Bu makaledeki yöntem, bunu başarmanıza yardımcı olacaktır.
Excel'de VBA kodu ile önceki hücre değerini kaydedin
Excel'de VBA kodu ile önceki hücre değerini kaydedin
Aşağıda gösterilen ekran görüntüsü gibi bir tablonuz olduğunu varsayarsak. C sütunundaki herhangi bir hücre değiştiyse, önceki değerini G sütununun ilgili hücresine kaydetmek veya açıklamaya otomatik olarak kaydetmek istersiniz. Bunu başarmak için lütfen aşağıdaki işlemleri yapın.
1. Çalışma sayfasında güncelleme sırasında kaydedeceğiniz değeri içerir, sayfa sekmesine sağ tıklayın ve seçin Kodu Görüntüle sağ tıklama menüsünden. Ekran görüntüsüne bakın:
2. Açılışta Uygulamalar için Microsoft Visual Basic penceresinde aşağıdaki VBA kodunu Kod penceresine kopyalayın.
Aşağıdaki VBA kodu, belirtilen 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 kaydedin
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: Yorumdaki önceki hücre değerini kaydedin
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 Subnot: Kodda, 7 rakamı, önceki hücreyi içine kaydedeceğiniz G sütununu ve C: C, önceki hücre değerini kaydedeceğiniz sütundur. Lütfen ihtiyaçlarınıza göre değiştirin.
3. tık Tools > Referanslar açmak için Referanslar - VBAProject iletişim kutusunda Microsoft Komut Dosyası Çalışma Zamanı kutusunu seçin ve son olarak OK buton. Ekran görüntüsüne bakın:
4. Tuşuna basın. Ara Toplam + Q kapatmak için anahtarlar Uygulamalar için Microsoft Visual Basic pencere.
Bundan sonra, C sütunundaki hücre değeri güncellendiğinde, hücrenin önceki değeri G sütunundaki ilgili hücrelere kaydedilecek veya aşağıdaki ekran görüntülerinde gösterildiği gibi yorumda kaydedilecektir.
Önceki hücre değerlerini diğer hücrelere kaydedin:
Yorumlarda önceki hücre değerlerini kaydet:
En İyi Ofis Üretkenlik Araçları
Kutools for Excel ile Excel Becerilerinizi Güçlendirin ve Daha Önce Hiç Olmadığı Gibi Verimliliği Deneyimleyin. Kutools for Excel, Üretkenliği Artırmak ve Zamandan Tasarruf Etmek için 300'den Fazla Gelişmiş Özellik Sunar. En Çok İhtiyacınız Olan Özelliği Almak İçin Buraya Tıklayın...
Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir
- Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
- Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
- Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
