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

这篇博客介绍了如何在Excel中实现单元格值变更的监测与锁定机制。当选定的单元格值发生变化时,程序会记录并还原已锁定单元格的原始值,同时在日志表中记录未锁定单元格的修改情况。该机制通过VBA代码实现,能有效跟踪和管理工作表数据的变动。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

 先看效果: 

在模块中插入以下代码

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

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值