自动另存修改项数据的功能，代码有点问题

yooha

诸位大师晚上好，本人小白今天折腾表格代码时意外发现了区域内当非空单元格被修改后触发清除指定单元格数据的功能，那么能否实现当单元格修改 自动保存修改前的那行数据（如果是多行同时修改就保存多行）到另一张表格作为历史纪录，逐行累加。 不知道有没有现成的功能，手上其他老师的代码也没想出来如何进行逻辑上的变通来实现这个功能。

个人猜想：假设表1为录入表，当操作表1时临时另存当前所有选中项所在行到表2，未发生修改则清空表2，若有修改则保存到表3做为历史纪录 然后清空表2。不知这样可行吗？
--------------------------------------------------------------------------------------------------------------------------------------------
保存历史记录.rar (32.95 KB, 下载次数: 0)

2018-8-12 23:29 上传

点击文件名下载附件

我修改了一位老师的代码，但不知为什么触发后会运行两遍。附件为那位老师的原代码。

Sub SaveData()
Dim Ar, Br, Cr(), i%, n%, k%, m%, D
n = Cells(Rows.Count, 1).End(xlUp).Row
If n = 1 Then
    [w1] = "录入后请及时刷新"
    Exit Sub
End If
Ar = Range("a2:u" & n)
Set D = CreateObject("scripting.dictionary")
With Sheets("历史记录表")
    n = .Cells(Rows.Count, 2).End(xlUp).Row
    If n > 1 Then
        Br = .Range("b2:v" & n)
        For k = 1 To n - 1
            D(Br(k, 1) & Br(k, 2) & Br(k, 3) & Br(k, 4) & Br(k, 5) & Br(k, 6) & Br(k, 7) & Br(k, 8) & Br(k, 9) & Br(k, 10) & Br(k, 11) & Br(k, 12) & Br(k, 13) & Br(k, 14) & Br(k, 15) & Br(k, 16) & Br(k, 17) & Br(k, 18) & Br(k, 19) & Br(k, 20) & Br(k, 21)) = ""
        Next
    End If
End With
ReDim Cr(1 To UBound(Ar), 1 To 22)
For k = 1 To UBound(Ar)
    If D.exists(Ar(k, 1) & Ar(k, 2) & Ar(k, 3) & Ar(k, 4) & Ar(k, 5) & Ar(k, 6) & Ar(k, 7) & Ar(k, 8) & Ar(k, 9) & Ar(k, 10) & Ar(k, 11) & Ar(k, 12) & Ar(k, 13) & Ar(k, 14) & Ar(k, 15) & Ar(k, 16) & Ar(k, 17) & Ar(k, 18) & Ar(k, 19) & Ar(k, 20) & Ar(k, 21)) Then
        If MsgBox("第" & k + 1 & "行数据已经存在，是否继续保存？", vbYesNo, "请确认") = vbNo Then GoTo Newline
    End If
    m = m + 1
    Cr(m, 1) = Now: Cr(m, 2) = Ar(k, 1): Cr(m, 3) = Ar(k, 2): Cr(m, 4) = Ar(k, 3): Cr(m, 5) = Ar(k, 4): Cr(m, 6) = Ar(k, 5): Cr(m, 7) = Ar(k, 6): Cr(m, 8) = Ar(k, 7): Cr(m, 9) = Ar(k, 8): Cr(m, 10) = Ar(k, 9): Cr(m, 11) = Ar(k, 10): Cr(m, 12) = Ar(k, 11): Cr(m, 13) = Ar(k, 12): Cr(m, 14) = Ar(k, 13): Cr(m, 15) = Ar(k, 14): Cr(m, 16) = Ar(k, 15): Cr(m, 17) = Ar(k, 16): Cr(m, 18) = Ar(k, 17): Cr(m, 19) = Ar(k, 18): Cr(m, 20) = Ar(k, 19): Cr(m, 21) = Ar(k, 20): Cr(m, 22) = Ar(k, 21)
Newline:
Next
If m > 0 Then
    Sheets("历史记录表").Range("a" & n + 1).Resize(m, 22) = Cr
    MsgBox "数据保存完毕!"
End If
End Sub