如何記住或保存Excel中更改單元格的先前單元格值？

通常情況下，當用新內容更新單元格時，先前的值將被覆蓋，除非撤消Excel中的操作。 但是，如果您想保留先前的值與更新的值進行比較，則將以前的值保存到另一個單元格或單元格註釋中將是一個不錯的選擇。 本文中的方法將幫助您實現它。

在Excel中用VBA代碼保存以前的單元格值

在Excel中用VBA代碼保存以前的單元格值

驚人！ 在Excel中使用高效標籤，如Chrome，Firefox和Safari！

節省50％的時間，每天為您減少數千次鼠標點擊！

假設你有一個如下圖所示的表格。 如果C列中的任何單元格發生更改，則需要將其先前的值保存到G列的相應單元格中或自動保存註釋。 請按照以下步驟來實現。

1。 在工作表中包含更新時保存的值，右鍵單擊工作表選項卡並選擇 查看代碼 從右鍵菜單。 看截圖：

2。 在開幕式上 Microsoft Visual Basic for Applications 窗口中，將下面的VBA代碼複製到代碼窗口中。

以下VBA代碼可幫助您將指定列的先前單元格值保存到另一列中。

VBA代碼：將以前的單元格值保存到另一列單元格中

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

為了將以前的單元格值保存在註釋中，請應用下面的VBA代碼

VBA代碼：保存評論中的前一個單元格值

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

備註：在代碼中，數字7表示您將保存上一個單元格的列G，而C：C是您將保存上一個單元格值的列。 請根據您的需求更改它們。

3。 點擊 工具 > 參考 打開 引用 - VBAProject 對話框，檢查 Microsoft腳本運行時 框，最後點擊 OK 按鈕。 看截圖：

4。 按 其他 + Q 鍵關閉 Microsoft Visual Basic for Applications 窗口。

從現在開始，當列C中的單元格值更新時，單元格的前一個值將被保存到列G中的相應單元格中，或者保存在註釋中，如下面的截圖所示。

將以前的值保存到另一個單元格

將以前的值保存在評論中：

Kutools for Excel解決了您的大多數問題，並使您的生產率提高了80％

• 重用: 快速插入 複雜的公式，圖表 以及你以前用過的任何東西; 加密單元格 密碼; 創建郵件列表 並發送電子郵件...
• 超級方程式酒吧 （輕鬆編輯多行文字和公式）; 閱讀佈局 （輕鬆讀取和編輯大量單元格）; 粘貼到過濾範圍...
• 合併單元格/行/列 不丟失數據; 分裂細胞含量; 組合重複的行/列...防止重複的細胞; 比較範圍...
• 選擇複製或唯一 行; 選擇空行 （所有細胞都是空的）; 超級查找和模糊查找 在許多工作簿中; 隨機選擇......
• 精確複製 多個單元格而不更改公式參考; 自動創建參考 多張表; 插入項目符號，複選框等等......
• 提取文本，添加文本，按位置刪除， 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
• 超級過濾器 （將過濾方案保存並應用到其他工作表）; 高級排序 按月/週/日，頻率等; 特殊過濾器 用粗體，斜體......
• 結合工作簿和工作表; 根據鍵列合併表; 將數據拆分為多個表格; 批量轉換xls，xlsx和PDF...
• 超過300強大的功能。 支持Office / Excel 2007-2019和365。 支持所有語言。 在您的企業或組織中輕鬆部署。 全功能30天免費試用。

閱讀更多... 免費下載... 採購...

---

Office選項卡為Office提供選項卡式界面，使您的工作更輕鬆

• 在Word，Excel，PowerPoint中啟用選項卡式編輯和閱讀，Publisher，Access，Visio和Project。
• 在同一窗口的新選項卡中打開並創建多個文檔，而不是在新窗口中。
• 通過50％提高您的工作效率，每天為您減少數百次鼠標點擊！

閱讀更多... 免費下載... 採購...