取消一列的保护

flowerzhou2018

整个表格一部分表格保护了，一部分可以输入，现在想把被保护的一列取消保护，但是代码锁定，撤销保护后，一编辑就触动change，自动锁死了，要怎样操作才能实现呢？



Private Sub Worksheet_Change(ByVal Target As Range)

     Application.EnableEvents = False   '禁用此事件
'Application.ScreenUpdating = False '禁止屏幕刷新
    Application.Calculation = xlManual
     If Target.Row < 5 Or Target.Row > 104 Then Exit Sub
    ActiveSheet.Unprotect Password:="880"

    Dim r%, jcount%, n%, sr%


    r = Target.Row
    With Sheet6
        strsql = "select * from [基础信息$A1:p" & Sheet5.[a65536].End(xlUp).Row & "] where 员工编号 like  '%" & .Cells(r, 1) & "%' or 员工姓名 like  '%" & .Cells(r, 1) & "%' "
        If CNN.State = 0 Then CNN.Open DbPath & ThisWorkbook.FullName
        RST.Open strsql, CNN, 1, 1
        If RST.EOF = False Then
            jcount = RST.RecordCount
            If jcount = 1 Then
                If Application.CountIf(.Range("a4:a" & r - 1), RST!员工编号) > 0 Or Application.CountIf(.Range("a" & r + 1 & ":a104"), RST!员工编号) > 0 Then
                    .Cells(r, 1).ClearContents
                    RST.Close
                    Application.EnableEvents = True    '启用此事件
                    MsgBox "已存在该员工的薪资信息！", 1 + 64, "系统提示"
                    Exit Sub
                End If
                .Cells(r, 1) = RST!员工编号
                .Cells(r, 2) = RST!员工姓名
                .Cells(r, 3) = RST!隶所部门
                If IsNull(RST!暂缓发放) Then .Cells(r, 25) = IIf(IsNull(RST!工资卡号), "", RST!工资卡号) Else .Cells(r, 25).ClearContents
                .Cells(r, 17) = Round(Application.Sum(.Range("e" & r & ":k" & r)) - Application.Sum(.Range("l" & r & ":p" & r)), 2)
                If Sheet8.Range("a2:a803").Find(.Cells(r, 1), LookIn:=xlValues) Is Nothing Then
                    .Cells(r, 19) = iitax(.Cells(r, 17) - .Cells(r, 18))
                Else
                    sr = Sheet8.Range("a2:a803").Find(What:=.Cells(r, 1), Lookat:=xlWhole).Row
                    .Cells(r, 19) = iitax(.Cells(r, 17) - .Cells(r, 18) + Sheet8.Cells(sr, 17) - Sheet8.Cells(sr, 18)) - Sheet8.Cells(sr, 19)
                End If
                .Cells(r, 24) = Round(.Cells(r, 17) - Application.Sum(.Range("r" & r & ":w" & r)), 2)
            Else
                .Cells(r, 2).ClearContents
                .Cells(r, 3).ClearContents
                .Cells(r, 17).ClearContents
                .Cells(r, 24).ClearContents
                .Cells(r, 25).ClearContents
                If .Cells(r, 1) <> "" Then MsgBox "您输入的关键字太少！", 1 + 64, "系统提示"
            End If
        Else
            .Cells(r, 2).ClearContents
            .Cells(r, 3).ClearContents
            .Cells(r, 17).ClearContents
            .Cells(r, 24).ClearContents
            .Cells(r, 25).ClearContents
            MsgBox "未查到相符的记录！", 1 + 64, "系统提示"
        End If
        RST.Close
    End With
    ActiveSheet.Protect ("880"), DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    Application.Calculation = xlAutomatic
    '  Application.ScreenUpdating = True '启用屏幕刷新
    Application.EnableEvents = True    '启用此事件
End Sub

aman1516

权作参考：
[对指定区域的单元格进行锁定与解锁]
http://club.excelhome.net/thread-874471-3-1.html
见第22楼