Conas luach cille roimhe seo de chill athraithe in Excel a mheabhrú nó a shábháil?
De ghnáth, nuair a nuashonraítear ceall le hábhar nua, clúdófar an luach roimhe seo ach amháin má dhéantar an oibríocht in Excel a chealú. Mar sin féin, más mian leat an luach roimhe seo a choinneáil chun comparáid a dhéanamh leis an gceann nuashonraithe, beidh sé ina rogha maith an luach cille roimhe seo a shábháil i gcill eile nó isteach sa trácht cille. Cabhróidh an modh san Airteagal seo leat é a bhaint amach.
Sábháil luach cille roimhe seo le cód VBA in Excel
Sábháil luach cille roimhe seo le cód VBA in Excel
Má cheaptar go bhfuil tábla agat mar a thaispeántar thíos. Má d’athraigh aon chill i gcolún C, ba mhaith leat a luach roimhe seo a shábháil isteach sa chill chomhfhreagrach de cholún G nó trácht a shábháil go huathoibríoch. Déan mar a leanas le do thoil chun é a bhaint amach.
1. Sa bhileog oibre tá an luach a shábhálfaidh tú agus tú ag nuashonrú, cliceáil ar dheis ar an táb bileog agus roghnaigh Féach an cód ón roghchlár cliceáil ar dheis. Féach an pictiúr:
2. San oscailt Microsoft Visual Basic d’Fheidhmchláir fhuinneog, cóipeáil an cód VBA thíos i bhfuinneog an Chóid.
Cuidíonn an cód VBA seo a leanas leat luach cille roimhe seo de cholún sonraithe a shábháil i gcolún eile.
Cód VBA: Sábháil luach cille roimhe seo i gcill cholún eile
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 SubChun an luach cille roimhe seo a shábháil i dtrácht, cuir an cód VBA thíos i bhfeidhm
Cód VBA: Sábháil luach cille roimhe seo sa trácht
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 Subnótaí: Sa chód, léiríonn uimhir 7 an colún G a shábhálfaidh tú an chill roimhe seo, agus is é C: C an colún a shábhálfaidh tú an luach cille roimhe seo. Athraigh iad le do thoil bunaithe ar do chuid riachtanas.
3. cliceáil uirlisí > tagairtí a oscailt Tagairtí - VBAProject bosca dialóige, seiceáil an Microsoft Scripting Runtime bosca, agus ar deireadh cliceáil ar an OK cnaipe. Féach an pictiúr:
4. Brúigh an Eile + Q eochracha chun an Microsoft Visual Basic d’Fheidhmchláir fhuinneog.
As seo amach, nuair a dhéanfar luach na cille i gcolún C a nuashonrú, sábhálfar luach roimhe seo na cille i gcealla comhfhreagracha i gcolún G, nó sábhálfaidh tú sa trácht mar a léirigh scáileáin scáileáin thíos.
Sábháil luachanna cille roimhe seo i gcealla eile:
Sábháil luachanna cille roimhe seo i nótaí tráchta:
Uirlisí Táirgiúlachta Oifige is Fearr
Supercharge Do Scileanna Excel le Kutools le haghaidh Excel, agus Éifeachtúlacht Taithí Cosúil Ná Roimhe. Kutools le haghaidh Excel Tairiscintí Níos mó ná 300 Ardghnéithe chun Táirgiúlacht a Treisiú agus Sábháil Am. Cliceáil anseo chun an ghné is mó a theastaíonn uait a fháil ...
Tugann Tab Oifige comhéadan Tabbed chuig Office, agus Déan Do Obair i bhfad Níos Éasca
- Cumasaigh eagarthóireacht agus léamh tabbed i Word, Excel, PowerPoint, Foilsitheoir, Rochtain, Visio agus Tionscadal.
- Oscail agus cruthaigh cáipéisí iolracha i gcluaisíní nua den fhuinneog chéanna, seachas i bhfuinneoga nua.
- Méadaíonn do tháirgiúlacht 50%, agus laghdaíonn sé na céadta cad a tharlaíonn nuair luch duit gach lá!
