Kako si zapomniti ali shraniti prejšnjo vrednost celice spremenjene celice v Excelu?
Običajno bo pri posodabljanju celice z novo vsebino prejšnja vrednost pokrita, razen če razveljavite operacijo v Excelu. Če pa želite obdržati prejšnjo vrednost za primerjavo s posodobljeno, bo shranitev prejšnje vrednosti celice v drugo celico ali v komentar celice dobra izbira. Metoda v tem članku vam bo pomagala doseči.
Shranite prejšnjo vrednost celice s kodo VBA v Excelu
Shranite prejšnjo vrednost celice s kodo VBA v Excelu
Recimo, da imate tabelo, kot je prikazano na spodnji sliki zaslona. Če se je katera koli celica v stolpcu C spremenila, želite shraniti njeno prejšnjo vrednost v ustrezno celico stolpca G ali samodejno shraniti v komentar. Za dosego tega naredite naslednje.
1. Na delovnem listu je vrednost, ki jo boste shranili pri posodabljanju, z desno miškino tipko kliknite jeziček lista in izberite Ogled kode v meniju z desnim klikom. Oglejte si posnetek zaslona:
2. Na odprtju Microsoft Visual Basic za aplikacije okno, kopirajte spodnjo kodo VBA v okno Code.
Naslednja koda VBA vam pomaga shraniti prejšnjo vrednost celice določenega stolpca v drug stolpec.
Koda VBA: Shranite vrednost prejšnje celice v drugo celico stolpca
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 SubZa shranjevanje prejšnje vrednosti celice v komentarju uporabite spodnjo kodo VBA
Koda VBA: Shrani prejšnjo vrednost celice v komentar
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 SubOpombe: V kodi številka 7 označuje stolpec G, v katerega boste shranili prejšnjo celico, in C: C je stolpec, v katerega boste shranili prejšnjo vrednost celice. Prosimo, spremenite jih glede na vaše potrebe.
3. klik Orodja > Reference da odprete Reference - VBAProject pogovorno okno, preverite Izvajanje Microsoftovih skriptov in na koncu kliknite OK . Oglejte si posnetek zaslona:
4. Pritisnite druga + Q tipke za zapiranje Microsoft Visual Basic za aplikacije okno.
Od zdaj naprej, ko se vrednost celice v stolpcu C posodobi, se prejšnja vrednost celice shrani v ustrezne celice v stolpcu G ali shrani v komentar, kot je prikazano spodaj.
Shrani prejšnje vrednosti celic v druge celice:
Shranite prejšnje vrednosti celic v komentarje:
Najboljša pisarniška orodja za produktivnost
Napolnite svoje Excelove spretnosti s Kutools za Excel in izkusite učinkovitost kot še nikoli prej. Kutools za Excel ponuja več kot 300 naprednih funkcij za povečanje produktivnosti in prihranek časa. Kliknite tukaj, če želite pridobiti funkcijo, ki jo najbolj potrebujete...
Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo
- Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
- Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
- Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
