Note: The other languages of the website are Google-translated. Back to English

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:


Yr Offer Cynhyrchedd Swyddfa Gorau

Mae Kutools for Excel yn Datrys y rhan fwyaf o'ch Problemau, ac yn Cynyddu Eich Cynhyrchedd 80%

  • Ailddefnyddio: Mewnosod yn gyflym fformwlâu cymhleth, siartiau ac unrhyw beth rydych chi wedi'i ddefnyddio o'r blaen; Amgryptio Celloedd gyda chyfrinair; Creu Rhestr Bostio ac anfon e-byst ...
  • Bar Fformiwla Gwych (golygu llinellau lluosog o destun a fformiwla yn hawdd); Cynllun Darllen (darllen a golygu nifer fawr o gelloedd yn hawdd); Gludo i'r Ystod Hidlo...
  • Uno Celloedd / Rhesi / Colofnau heb golli Data; Cynnwys Celloedd Hollt; Cyfuno Rhesi / Colofnau Dyblyg... Atal Celloedd Dyblyg; Cymharwch y Meysydd...
  • Dewiswch Dyblyg neu Unigryw Rhesi; Dewiswch Blank Rows (mae pob cell yn wag); Darganfyddiad Gwych a Darganfyddiad Niwlog mewn Llawer o Lyfrau Gwaith; Dewis ar Hap ...
  • Copi Union Celloedd Lluosog heb newid cyfeirnod fformiwla; Auto Creu Cyfeiriadau i Daflenni Lluosog; Mewnosod Bwledi, Blychau Gwirio a mwy ...
  • Testun Detholiad, Ychwanegu Testun, Tynnu yn ôl Swydd, Tynnwch y Gofod; Creu ac Argraffu Subtotals Paging; Trosi rhwng Cynnwys a Sylwadau Celloedd...
  • Hidlo Super (arbed a chymhwyso cynlluniau hidlo i ddalenni eraill); Trefnu Uwch yn ôl mis / wythnos / dydd, amlder a mwy; Hidlo Arbennig gan feiddgar, italig ...
  • Cyfuno Llyfrau Gwaith a Thaflenni Gwaith; Uno Tablau yn seiliedig ar golofnau allweddol; Rhannwch Ddata yn Daflenni Lluosog; Trosi Swp xls, xlsx a PDF...
  • Mwy na 300 o nodweddion pwerus. Yn cefnogi Swyddfa / Excel 2007-2019 a 365. Yn cefnogi pob iaith. Defnydd hawdd yn eich menter neu sefydliad. Nodweddion llawn treial am ddim 30 diwrnod. Gwarant arian yn ôl 60 diwrnod.
tab kte 201905

Mae Tab Office yn Dod â rhyngwyneb Tabbed i'r Swyddfa, a 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!
gwaelod officetab
sylwadau (16)
Dim sgôr eto. Byddwch y cyntaf i sgorio!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Dwi angen rhywbeth fel hyn, ond dim ond mewn celloedd penodol (e.e.: G12 i ddangos yn H23 yr hen werth)
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Ac arall ... mae angen y rhediad hwn arnaf pan fydd cell yn newid o ganlyniad (EX.: A1 + B1 = C1 ... os byddaf yn newid gwerth A neu B, nid yw'r sgript yn gweithio - nid oes dim yn digwydd yng nghell G)
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo! Roeddwn i eisiau gwybod a yw'n bosibl cofrestru lluosogi newidiadau i'r gell, rwy'n golygu, os byddaf yn rhoi data yn y gell C2 ac yna'n newid y data hwnnw ar gyfer gwybodaeth arall, mae'r data blaenorol yn trosglwyddo i'r gell G2 (fel yn y swydd hon ), ond Os byddaf yn newid y gwerth unwaith eto yng nghell C2, mae'r ail newid a wneuthum yn trosglwyddo i'r gell H2 (er enghraifft) ac yn awr cofrestrais wybodaeth y 3 symudiad a sylweddolais, a gwnewch hynny bron i 5 gwaith mwy (arbedwch y gwerth celloedd blaenorol 5 gwaith). Pe gallech fy helpu byddwn yn gwerthfawrogi cymaint oherwydd yma yn eich post dyma'r unig le y deuthum o hyd iddo i ddatrys fy mhroblem yn rhannol. Diolch am rannu'r cynnwys hwn !!!!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
wnaethoch chi ddarganfod sut i wneud hyn?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Roeddwn i'n meddwl am mewn brawddeg "Os/arall" ond dwi'n newydd yn defnyddio VBA, felly os oes gennych chi bost arall a allai fy helpu, plis rhannwch gyda mi, a diolch eto ! dal i rannu'r wybodaeth
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Pam nad yw'r cod uchod yn gweithio ar gyfer data DDE, mae gen i ddata mewn colofn sy'n newid trwy dde , ond yr eiliad y cymhwysais y cod hwn i gadw gwerth blaenorol y golofn honno i golofn arall , nid yw'n gwneud dim;

Gwerthfawrogir yn fawr unrhyw gymorth i gyflawni hyn.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo!

Swyddogaeth wych ond sut y gellir ei addasu i weithio hefyd gyda cell Rwyf am gofio'r gwerth sy'n cynnwys VLOOKUP ? Yn anffodus ni allwn ddod o hyd i beth i'w addasu i arbed y gwerth o'r VLOOKUP. Fel y mae nid yw'n gweithio pan mae VLOOKUP's yn y canol :(

Diolch ymlaen llaw am eich help!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, felly addaswyd y cod "VBA: Arbed gwerth celloedd blaenorol i mewn i gell colofn arall" a wnaethoch, fodd bynnag mae gennyf un neu ddau o gwestiynau:

1. Sut mae'r cod yn gwybod pa golofn sydd â'r gwerthoedd newydd? (a fyddai, ar ôl diweddariad arall, â'i werthoedd allan yn y golofn arall)
2. Sut gallwch chi wneud hwn yn Macro? Neu gwnewch iddo redeg yn awtomatig pan fydd rhaglen arall yn galw'r xlsm. ffeil?

diolch
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Mae hyn ar gyfer gwerth un gell, ond sut mae gwerth cell lluosog, rydw i eisiau storfa ddata 4 cell a diweddaru fel hyn er enghraifft data celloedd C, D, E, F i mewn i gell G, H, I, J yn y drefn honno, sut all wneud helpwch os gwelwch yn dda
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Os mai fformiwla yw'r gell rydw i am ei chadw, bydd y gell G yn arbed y fformiwla yn unig, ac yn cyfrifo'r gwerth. Mae angen i mi arbed y gwerth - nid y fformiwla. Sut alla i ddweud wrth y cod VBA, bod y gwerth yn newid er nad yw'r fformiwla yn cael ei newid. Cofion gorau Flemming
Lleihawyd y sylw hwn gan y safonwr ar y wefan
A oes ffordd i ailadrodd hyn ar gyfer pob newid? Hoffwn i'r Blwch Sylwadau ddangos yr holl gofnodion blaenorol os yn bosibl.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Jennie! A wnaethoch chi lwyddo i ddatrys y mater hwn? Rwyf hefyd yn ceisio casglu'r holl gofnodion newydd mewn blwch sylwadau, ond rwy'n cael anawsterau i addasu'r cod VBA i hyn. Diolch!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Mae'n dda os byddwch yn teipio i mewn. A allwch chi fy helpu i'w weithio pan fydd data'n cael ei fewnbynnu trwy ddefnyddio gwerth swyddogaeth o DDE (Dynamic Data Exchange) hefyd?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Heia,
Mae'n ddrwg gennyf, ni allaf ddatrys y broblem hon. Rwy'n awgrymu eich bod yn postio'r broblem i'r fforwm isod i gael help gan selogion Excel eraill.
https://www.extendoffice.com/forum/kutools-for-excel.html
Lleihawyd y sylw hwn gan y safonwr ar y wefan
cho e hỏi chút là có cách nào để khi tính toán cộng trừ xong thì neu sẽ lưu lại giá trị khi tính toán xong không ạ
ví dụ:
Giá trị ở cột A = cột B + cột C
Khi tính toán xong cột a s ẽ lưu giá trị sau khi đã tính toán xong, lần tiếp theo ti tính toán thì nó cột a sẽ lấ lấy giá trị trị ta ể tạn tạ tạn tạ t ể Tạ tạ Tạ tạ tạ tạ tạ tạ tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ Tạ DO YN
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Trung,
Mae'r cod wedi'i ddiweddaru. Rhowch gynnig arni. Diolch am eich adborth.
Yn y cod canlynol, y rhif 5 yn y llinell hon Gosod xDCell = Celloedd(xCell.Row, 5) yn cynrychioli colofn E lle byddwch yn gosod y gwerth blaenorol. Mae A:A yn cyfeirio at y celloedd yng ngholofn A. Mae angen i chi gadw gwerthoedd blaenorol y celloedd hyn.

Dim xRg As Range
'Updated by Extendoffice 20220803
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
    Dim X
    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, 5)
        
        xDCell.NumberFormatLocal = xCell.NumberFormatLocal
        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("A:A"))
    End If
Label1:
    Set xRg = Intersect(Target, Range("A:A"))
    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 ' xRgArea(J).Formula
        Next
    Next
    Set xChangeRg = Nothing
    Set xRg = Nothing
    Set xDependRg = Nothing
    Application.EnableEvents = True
End Sub
Nid oes unrhyw sylwadau wedi'u postio yma eto
Gadewch eich sylwadau
Postio fel Gwestai
×
Graddiwch y swydd hon:
0   Cymeriadau
Lleoliadau a Awgrymir