Jak zapamiętać lub zapisać poprzednią wartość komórki zmienionej komórki w programie Excel?
Zwykle podczas aktualizowania komórki o nową zawartość poprzednia wartość zostanie uwzględniona, chyba że cofniesz operację w programie Excel. Jeśli jednak chcesz zachować poprzednią wartość do porównania ze zaktualizowaną, dobrym wyborem będzie zapisanie poprzedniej wartości komórki w innej komórce lub w komentarzu do komórki. Pomoże Ci w tym metoda opisana w tym artykule.
Zapisz poprzednią wartość komórki za pomocą kodu VBA w programie Excel
Zapisz poprzednią wartość komórki za pomocą kodu VBA w programie Excel
Przypuśćmy, że masz tabelę pokazaną na poniższym zrzucie ekranu. Jeśli dowolna komórka w kolumnie C uległa zmianie, chcesz zapisać jej poprzednią wartość w odpowiedniej komórce kolumny G lub automatycznie zapisać komentarz. Aby to osiągnąć, wykonaj następujące czynności.
1. W arkuszu zawierającym wartość, którą zapiszesz podczas aktualizacji, kliknij prawym przyciskiem myszy kartę arkusza i wybierz Wyświetl kod z menu po kliknięciu prawym przyciskiem myszy. Zobacz zrzut ekranu:
2. W otwarciu Microsoft Visual Basic for Applications skopiuj poniższy kod VBA do okna Code.
Poniższy kod VBA pomaga zapisać poprzednią wartość komórki określonej kolumny w innej kolumnie.
Kod VBA: zapisz poprzednią wartość komórki w innej komórce kolumny
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
Aby zapisać poprzednią wartość komórki w komentarzu, zastosuj poniższy kod VBA
Kod VBA: zapisz poprzednią wartość komórki w komentarzu
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
Note: W kodzie liczba 7 oznacza kolumnę G, w której zapiszesz poprzednią komórkę, a C: C to kolumna, w której zapiszesz poprzednią wartość komórki. Zmień je w zależności od potrzeb.
3. kliknij Tools > Referencje otworzyć Referencje - VBAProject w oknie dialogowym, sprawdź Środowisko wykonawcze skryptów firmy Microsoft Microsoft i na koniec kliknij OK przycisk. Zobacz zrzut ekranu:
4. wciśnij inny + Q klucze do zamknięcia Microsoft Visual Basic for Applications okno.
Odtąd, po zaktualizowaniu wartości komórki w kolumnie C, poprzednia wartość komórki zostanie zapisana w odpowiednich komórkach w kolumnie G lub zostanie zapisana w komentarzu, jak pokazano na poniższych zrzutach ekranu.
Zapisz poprzednie wartości komórek w innych komórkach:
Zapisz poprzednie wartości komórek w komentarzach:
Najlepsze narzędzia biurowe
Zwiększ swoje umiejętności Excela dzięki Kutools for Excel i doświadcz wydajności jak nigdy dotąd. Kutools dla programu Excel oferuje ponad 300 zaawansowanych funkcji zwiększających produktywność i oszczędzających czas. Kliknij tutaj, aby uzyskać funkcję, której najbardziej potrzebujesz...
Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę
- Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
- Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
- Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!