【求助】excel中的工作表如何取消自动保护

whj188

excel表格每次取消保护后，点击一下原来保护的单元格，马上又自动锁上了，求问代码应该怎么改才会不自动保护？另外如果有大神能解释一下对应语句的含义就更好了，谢谢_(:з」∠)_
Dim arr
Sub Hsaness()
Sheet75.Select
ActiveSheet.Unprotect Password:="abc@1"
Sname = ActiveSheet.Name
lastrow = Worksheets(Sname).Range("A65535").End(xlUp).Row

If lastrow > 5 Then
Range("O5:AD5").Select
Selection.AutoFill Destination:=Range("O5:AD" & lastrow), Type:=xlFillDefault
End If
Columns("AA:AA").Select
Selection.Copy
Columns("P:P").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
Columns("AB:AB").Select
Selection.Copy
Columns("Q:Q").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
Columns("AC:AC").Select
Selection.Copy
Columns("S:S").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
Columns("AD:AD").Select
Selection.Copy
Columns("U:U").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False

x = HypMenuVSubmitData()
Sheet75.Range("AE:ZZ").Delete
ActiveSheet.EnableSelection = xlUnlockedCells
ActiveSheet.Protect Password:="abc@1", DrawingObjects:=True, Contents:=True, Scenarios:=False, UserInterfaceOnly:=False, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=False, AllowFiltering:=False, AllowUsingPivotTables:=False
Worksheets(Sname).Cells(5, 2).Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

On Error GoTo ErrL
    Sheet2.Columns("C:D").Clear

        If Target.Row > 4 And Target.Column = 1 And Target.Count = 1 Then
            Grow = Target.Row
            Gcol = Target.Column
            Alastrow = Sheet2.[A65536].End(xlUp).Row
            unname = Sheet75.Cells(Target.Row, Target.Column)
            For i = 2 To Alastrow
                If Sheet2.Cells(i, 1) Like "*" & unname & "*" Then
                    Dlastrow = Sheet2.[D65536].End(xlUp).Row
                    Sheet2.Cells(Dlastrow + 1, 4) = Sheet2.Cells(i, 1)
                    Sheet2.Cells(Dlastrow + 1, 3) = Dlastrow
                End If
            Next i
            
            Dlastrow = Sheet2.[D65536].End(xlUp).Row
            If Dlastrow > 2 Then
            Sheet75.Shapes("列表框 1").ControlFormat.RemoveAllItems
            For i = 2 To Dlastrow
                Sheet75.Shapes("列表框 1").ControlFormat.AddItem (Sheet2.Cells(i, 4))
            Next i
            With Sheet75.Shapes("列表框 1")
                .Visible = msoTrue
                .Top = Target.Top + Target.Height
                .Left = Target.Left
                .Height = Target.Height * 5
            End With
            Sheet75.Shapes("矩形 1").Visible = msoTrue
            Sheet75.Shapes("矩形 1").Left = Sheet75.Shapes("列表框 1").Left
            Sheet75.Shapes("矩形 1").Top = Sheet75.Shapes("列表框 1").Top + Sheet75.Shapes("列表框 1").Height
            Else
                Sheet2.Cells(29, 5) = "*" & Sheet75.Cells(Target.Row, Target.Column) & "*"
                Sheet75.Cells(Target.Row, Target.Column) = Sheet2.Cells(30, 5)
                If Len(Sheet75.Cells(Target.Row, Target.Column)) <= 4 Then
                    Sheet75.Cells(Grow, 1) = ""
                End If
            End If
        Else
            Sheet75.Shapes("列表框 1").ControlFormat.RemoveAllItems
            Sheet75.Shapes("列表框 1").Visible = msoFalse
            Sheet75.Shapes("矩形 1").Visible = msoFalse
        End If
Call tired
Application.EnableEvents = True
Exit Sub
ErrL:
    MsgBox "该公司不存在！"
    Sheet75.Shapes("列表框 1").ControlFormat.RemoveAllItems
    Sheet75.Shapes("列表框 1").Visible = msoFalse
    Sheet75.Shapes("矩形 1").Visible = msoFalse
    Sheet75.Cells(Grow, 1) = ""
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Sheet2.Cells(35, 5) = True Then
        Cancel = True
        Application.MacroOptions Macro:="PasteValue", ShortcutKey:="v"
        Application.StatusBar = "ctrl+v = 粘贴为值"
    End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row = 1 And Target.Column = 1 Then Exit Sub
    If Target.Row <= 4 Or Target.Column <> 1 Or Target.Count > 1 Then
        Sheet75.Shapes("列表框 1").ControlFormat.RemoveAllItems
        Sheet75.Shapes("列表框 1").Visible = msoFalse
        Sheet75.Shapes("矩形 1").Visible = msoFalse
        Call combo
    End If
End Sub