Sut i gofio neu arbed gwerth cell blaenorol cell wedi'i newid yn Excel?
Fel rheol, wrth ddiweddaru cell gyda chynnwys newydd, bydd y gwerth blaenorol yn cael ei gwmpasu oni bai bod y gweithrediad yn Excel yn cael ei ddadwneud. Fodd bynnag, os ydych chi am gadw'r gwerth blaenorol ar gyfer cymharu â'r un wedi'i ddiweddaru, bydd arbed y gwerth cell blaenorol i gell arall neu i mewn i'r sylw cell yn ddewis da. Bydd y dull yn yr erthygl hon yn eich helpu i'w gyflawni.
Arbedwch werth celloedd blaenorol gyda chod VBA yn Excel
Arbedwch werth celloedd blaenorol gyda chod VBA yn Excel
Gan dybio bod gennych dabl fel y dangosir isod. Os newidiodd unrhyw gell yng ngholofn C, rydych chi am arbed ei gwerth blaenorol i'r gell gyfatebol yng ngholofn G neu arbed sylw yn awtomatig. Gwnewch fel a ganlyn i'w gyflawni.
1. Yn y daflen waith mae'n cynnwys y gwerth y byddwch chi'n ei arbed wrth ddiweddaru, de-gliciwch y tab dalen a dewis Gweld y Cod o'r ddewislen clicio ar y dde. Gweler y screenshot:
2. Yn yr agoriad Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, copïwch y cod VBA isod i mewn i'r ffenestr Cod.
Mae'r cod VBA canlynol yn eich helpu i arbed gwerth celloedd blaenorol colofn benodol i golofn arall.
Cod VBA: Arbedwch werth celloedd blaenorol i mewn i gell golofn arall
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
Ar gyfer arbed gwerth blaenorol y gell mewn sylw, cymhwyswch y cod VBA isod
Cod VBA: Arbedwch werth celloedd blaenorol yn y sylw
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
Nodyn: Yn y cod, mae rhif 7 yn nodi'r golofn G y byddwch yn arbed y gell flaenorol iddi, a C: C yw'r golofn y byddwch yn arbed gwerth blaenorol y gell. Newidiwch nhw ar sail eich anghenion.
3. Cliciwch offer > Cyfeiriadau i agor y Cyfeiriadau - VBAProject blwch deialog, gwiriwch y Amser Rhedeg Sgriptio Microsoft blwch, ac yn olaf cliciwch y OK botwm. Gweler y screenshot:
4. Gwasgwch y Alt + Q allweddi i gau'r Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.
O hyn ymlaen, pan fydd gwerth y gell yng ngholofn C wedi'i diweddaru, bydd gwerth blaenorol y gell yn cael ei gadw i mewn i gelloedd cyfatebol yng ngholofn G, neu'n arbed sylw fel y dangosodd isod sgrinluniau.
Cadw gwerthoedd celloedd blaenorol mewn celloedd eraill:
Cadw gwerthoedd cell blaenorol mewn sylwadau:
Offer Cynhyrchiant Swyddfa Gorau
Supercharge Eich Sgiliau Excel gyda Kutools ar gyfer Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed. Kutools ar gyfer Excel Yn Cynnig Dros 300 o Nodweddion Uwch i Hybu Cynhyrchiant ac Arbed Amser. Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...
Mae Office Tab yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer
- Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
- Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
- Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!