保存上一个单元格VALUES,而不仅仅是最后一个(修改我的代码)

时间:2019-01-17 16:37:49

标签: excel vba

我发现了这个有趣的代码,几乎可以满足我的需求。 当一个单元格更改值时,此代码会将旧值保存到另一个单元格中。

问题是,当我再次更改它时,它将覆盖以前的“旧值”。因此,最后,我只有“ N值”和“ N-1值”。

我该怎么做才能保留所有先前的值? 假设我要修改单元格A1,旧值将变为B1。 我想到了CONCATENATE函数,将B1保存在其他位置,但是我觉得我做错了。

非常感谢您的耐心和时间。

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

0 个答案:

没有答案