Hoe kan ik de vorige celwaarde van een gewijzigde cel in Excel onthouden of opslaan?
Normaal gesproken wordt bij het bijwerken van een cel met nieuwe inhoud de vorige waarde gedekt, tenzij de bewerking in Excel ongedaan wordt gemaakt. Als u echter de vorige waarde wilt behouden om te vergelijken met de bijgewerkte, is het een goede keuze om de vorige celwaarde in een andere cel of in de celopmerking op te slaan. De methode in dit artikel zal u helpen om dit te bereiken.
Sla de vorige celwaarde op met VBA-code in Excel
Sla de vorige celwaarde op met VBA-code in Excel
Stel dat u een tabel heeft zoals hieronder afgebeeld. Als een cel in kolom C is gewijzigd, wilt u de vorige waarde opslaan in de overeenkomstige cel van kolom G of automatisch opslaan in commentaar. Ga als volgt te werk om dit te bereiken.
1. Bevat in het werkblad de waarde die u bij het bijwerken opslaat, klik met de rechtermuisknop op de bladtab en selecteer Bekijk code vanuit het rechtsklikmenu. Zie screenshot:
2. In de opening Microsoft Visual Basic voor toepassingen -venster, kopieer de onderstaande VBA-code naar het codevenster.
De volgende VBA-code helpt u de vorige celwaarde van de opgegeven kolom op te slaan in een andere kolom.
VBA-code: sla de vorige celwaarde op in een andere kolomcel
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
Pas de onderstaande VBA-code toe om de vorige celwaarde in een opmerking op te slaan
VBA-code: sla de vorige celwaarde op in de opmerking
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
Note: In de code geeft nummer 7 de kolom G aan waarin u de vorige cel wilt opslaan, en C: C is de kolom waarin u de vorige celwaarde wilt opslaan. Wijzig ze op basis van uw behoeften.
3. klikken Tools > Referenties om de te openen Refereces - VBAProject dialoogvenster, controleer de Microsoft Scripting-runtime vak en klik ten slotte op het OK knop. Zie screenshot:
4. druk de anders + Q toetsen om de Microsoft Visual Basic voor toepassingen venster.
Vanaf nu, wanneer de celwaarde in kolom C wordt bijgewerkt, wordt de vorige waarde van de cel opgeslagen in de corresponderende cellen in kolom G of opgeslagen in commentaar zoals hieronder weergegeven screenshots.
Bewaar vorige celwaarden in andere cellen:
Bewaar eerdere celwaarden in opmerkingen:
Beste Office-productiviteitstools
Geef uw Excel-vaardigheden een boost met Kutools voor Excel en ervaar efficiëntie als nooit tevoren. Kutools voor Excel biedt meer dan 300 geavanceerde functies om de productiviteit te verhogen en tijd te besparen. Klik hier om de functie te krijgen die u het meest nodig heeft...
Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker
- Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
- Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
- Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!