Hogyan lehet megjegyezni vagy elmenteni a megváltozott cellák előző cellájának értékét az Excel programban?
Normál esetben, ha egy cellát új tartalommal frissít, a rendszer az előző értéket fedi le, hacsak nem vonja vissza a műveletet az Excelben. Ha azonban meg szeretné tartani az előző értéket a frissített értékkel való összehasonlításhoz, jó választás lehet az előző cellaérték másik cellába vagy a cella megjegyzésébe történő mentése. A cikkben ismertetett módszer segít ennek elérésében.
Mentse az előző cellaértéket az Excel VBA kódjával
Mentse az előző cellaértéket az Excel VBA kódjával
Tegyük fel, hogy van egy táblázata az alábbi képernyőképen. Ha a C oszlop bármely cellája megváltozott, akkor elõzõ értékét el akarja menteni a G oszlop megfelelõ cellájába, vagy automatikusan megjegyzésként menti. Kérjük, tegye a következőket az eléréséhez.
1. A munkalap tartalmazza a frissítéskor menteni kívánt értéket, kattintson a jobb gombbal a lap fülre, és válassza ki Kód megtekintése a jobb egérgombbal kattintva. Lásd a képernyőképet:
2. A nyílásban Microsoft Visual Basic for Applications ablakba másolja az alábbi VBA kódot a Kód ablakba.
A következő VBA-kód segít megmenteni a megadott oszlop előző cellájának értékét egy másik oszlopba.
VBA kód: Az előző cellaérték mentése egy másik oszlop cellába
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 SubAz előző cellaérték megjegyzésben történő mentéséhez kérjük, alkalmazza az alábbi VBA kódot
VBA kód: Az előző cellaérték mentése a megjegyzésbe
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 SubMegjegyzések: A kódban a 7-es szám azt a G oszlopot jelöli, ahová az előző cellát menteni fogja, a C: C pedig azt az oszlopot, ahová az előző cella értékét elmenti. Kérjük, változtassa meg őket az Ön igényei szerint.
3. kettyenés Eszközök > Referenciák megnyitni Referenciák - VBAProject párbeszédpanelen ellenőrizze a Microsoft Scripting Runtime mezőbe, és végül kattintson a gombra OK gomb. Lásd a képernyőképet:
4. megnyomni a más + Q gombok a Microsoft Visual Basic for Applications ablak.
Mostantól a C oszlop cellaértékének frissítésekor a cella előző értéke a G oszlop megfelelő celláiba kerül, vagy kommentben menti, ahogy az alábbi képernyőképek mutatják.
Az előző cellaértékek mentése más cellákba:
A korábbi cellaértékek mentése a megjegyzésekben:
A legjobb irodai hatékonyságnövelő eszközök
Töltsd fel Excel-készségeidet a Kutools for Excel segítségével, és tapasztald meg a még soha nem látott hatékonyságot. A Kutools for Excel több mint 300 speciális funkciót kínál a termelékenység fokozásához és az időmegtakarításhoz. Kattintson ide, hogy megszerezze a leginkább szükséges funkciót...
Az Office lap füles felületet hoz az Office-ba, és sokkal könnyebbé teszi a munkáját
- Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
- Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
- 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
