如何使用vba禁用单元格中的更改？

Question

我正在使用波纹管代码:此代码用于示例:如果我在单元格A1中输入任何值,则单元格B1显示时间戳.

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    With Target
       If .Count > 1 Then Exit Sub
       If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
           Application.EnableEvents = False
           If IsEmpty(.Value) Then
               .Offset(0, 1).ClearContents
           Else
               With .Offset(0, 1)
                   .NumberFormat = "hh:mm AM/PM"
                   .Value = Now
               End With
           End If
           Application.EnableEvents = True
       End If
    End With
    End Sub

我现在要做的是,一旦用宏创建时间戳,就保护/不可编辑单元格"B1:B10".我谷歌如何保护,但我很难插入我找到的代码.任何人都可以帮助我如何构建/插入此代码到我的原始代码？

    Private Sub Worksheet_Change(ByVal Target As Range)
    'set your criteria here
    If Target.Column = 1 Then

        'must disable events if you change the sheet as it will
        'continually trigger the change event
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True

        MsgBox "You cannot do that!"
    End If
    End Sub

或者这段代码:

    'select the cell you want to be editable
    Worksheets("Sheet1").Range("B2:C3").Locked = False
    'then protect the entire sheet but still vba program can modify instead.
    Worksheets("Sheet1").Protect UserInterfaceOnly:=True

感谢Kazjaw.这是最终的代码.

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    'Protect cell "B1:B10"
    Worksheets("Sheet1").Cells.Locked = False
    Worksheets("Sheet1").Range("B1:b10").Locked = True
    Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=Tru

    With Target
       If .Count > 1 Then Exit Sub
       If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
           Application.EnableEvents = False
           If IsEmpty(.Value) Then
               .Offset(0, 1).ClearContents
           Else
               With .Offset(0, 1)
                   .NumberFormat = "hh:mm AM/PM"
                   .Value = Now
               End With
           End If
           Application.EnableEvents = True
       End If
    End With
    End Sub

Answer 1

如果您只想保护范围B1:B10,那么您只需运行此子程序一次:

Sub ProtectCellsInB()

    Worksheets("Sheet1").Cells.Locked = False
    Worksheets("Sheet1").Range("B1:b10").Locked = True
    Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=True

End Sub

我做了一个修改 - 我添加了一个保护密码,你可以删除.

如果你不确定如何运行它,那么你可以在你的最后添加整个内部代码Private Sub Worksheet_Change(ByVal Target As Excel.Range)