VBA锁定单元格并记录单元格修改日志无bug篇_vba .locked

 先看效果: 

在模块中插入以下代码

Type OldRng
    Formula As Variant '保存值
    Address As String '保存地址
    Locked As Boolean '是否锁定
    Changed As Boolean '是否被修改
End Type
 
Public iRng() As OldRng '用来锁定的单元格

在工作表sheet1中插入以下代码,新建一个sheet,在工程中将名字改为log如图:

然后在sheet2中A20单元格中输入2,表示从第二行开始写日志

Option Explicit
 
Private iRngFull As Boolean 'iRng是否为nothing
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Application.ScreenUpdating = False
    'Application.Calculation = xlCalculationManual
    
    Dim i As Long
    Dim logLine As Long
    Dim flashFlag As Boolean 'true:被锁定的单元格值被修改了;false:被锁定的单元格值没有修改
    Dim valueChangeFlag As Boolean 'true:没有锁定的单元格值被修改了;false:没有锁定的单元格值没有修改
    '判断首次改变单元格
    If Not iRngFull Then
        '首次改变选中的单元格则保存本次选中单元格为下次改变选中作准备
        saveIRng Target, False
        '退出sub
        Exit Sub
    End If
    
    Application.StatusBar = False
    For i = 1 To UBound(iRng)
        '判断值改变
        If Range(iRng(i).Address).Formula <> iRng(i).Formula Then
            If iRng(i).Locked Then
                
                '如果改变标记flashFlag
                flashFlag = True
                '存放锁定的单元格序列在iRng中,将要还原的值
                iRng(i).Changed = True
                'i = UBound(iRng)
            Else
                With log
                    logLine = .Cells(1, 20)
                    .Cells(logLine, 1) = Now
                    .Cells(logLine, 2) = iRng(i).Address
                    .Cells(logLine, 3).NumberFormatLocal = "@"
                    .Cells(logLine, 3) = iRng(i).Formula
                    .Cells(logLine, 4) = Range(iRng(i).Address)
                    .Cells(1, 20) = logLine + 1
                End With
                
                '存放没有锁定的单元格序列在iRng中,也就是被修改了的值
                valueChangeFlag = True
                '标记没有锁定单元格的改变状态
                iRng(i).Changed = True
            End If
        End If
    Next i
    
    If flashFlag Or valueChangeFlag Then
        Application.StatusBar = iRng(0).Address & "__中有已应用锁定的单元格"
        If flashFlag Then
            '运行到这里就说明单元格的值被修改了,下面是处理还原的代码
           
            '应用手动计算,提高效率,没有关闭屏幕刷新是为了让用户看到值被还原的过程
            Application.Calculation = xlCalculationManual
            For i = 1 To UBound(iRng)
                If Range(iRng(i).Address).Column < 26 And iRng(i).Locked Then
                    Range(iRng(i).Address).Formula = iRng(i).Formula
                End If
            Next i
            '还原完成,如果公式是手动计算则应用公式自动计算
            Application.Calculation = xlCalculationAutomatic
        End If
        '如果没有被锁定的单元格值被修改了,则注入撤消功能
    End If
    '单元格的值没有被修改,保存本次选中的单元格到iRng中
    saveIRng Target, valueChangeFlag
    'Application.ScreenUpdating = True
    'Application.Calculation = xlCalculationAutomatic
    
End Sub
 
Private Sub saveIRng(ByVal Target As Range, valueChangeFlag As Boolean)
    Dim rngOne
    Dim tgRow As Long
    Dim tgColumn As Long
    Dim useRngRow As Long
    Dim useRngColumn As Long
    Dim i As Long
    Dim k As Long
    k = 0
    i = 1
    
    tgRow = Target.Row + Target.Rows.Count '选中区域的最高行
    useRngRow = UsedRange.Row + UsedRange.Rows.Count '选中区域的最大列
    tgColumn = Target.Column + Target.Columns.Count '已使用区域的最高行
    useRngColumn = UsedRange.Column + UsedRange.Columns.Count ''已使用区域的最大列
    
    
    If tgRow > useRngRow Or tgColumn > useRngColumn Then
        Application.StatusBar = "超出已使用区域, 超出的单元格保护不会生效"
        Set Target = Range(Cells(Target.Row, Target.Column), Cells(useRngRow, useRngColumn))
    End If
    
    ReDim iRng(Target.Count)
    iRng(0).Address = Target.Address
    If Target.Count > 65535 Then Exit Sub
    For Each rngOne In Target
        iRng(i).Address = rngOne.Address
        iRng(i).Locked = CBool(Cells(rngOne.Row, 26))
        If iRng(i).Locked Then
            k = k + 1
        End If
        iRng(i).Formula = rngOne.Formula
        i = i + 1
    Next rngOne
    iRngFull = True
    Application.StatusBar = k / Target.Columns.Count & "行被锁定"
 
End Sub