Question

我需要根据从另一个单元格列表中选择值来锁定特定范围的单元格。

具体来说，我已经为N5到N36列创建了数据验证列表，当从单元格N5中选择值“存在”时，我想将该特定行O5锁定到U5。

，即N6中的“存在”会将O6锁定到U6，依此类推。

类似于其他行直到N36。

如果用户选择“不存在”，那么我希望这些单元格保持解锁和可编辑状态，类似于上述条件。

我已经使用我使用宏的基本知识从各种论坛尝试过宏，但大多数都锁定了整个表。

我试过的代码：

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("N5:N36")) Is Nothing Then 
        ActiveSheet.Unprotect 

        If Target.Value = "Exist" Then 
            Range("O" & Target.Column & ":U" & Target.Column).Select Selection.Locked = False   
        Else 
            Range("O" & Target.Column & ":U" & Target.Column).Select Selection.Locked = True 
        End If 
    End If 

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
End Sub

我非常感谢您的快速帮助。

先谢谢。

Answer 1

这是你正在尝试的（尝试和测试）？另请参阅THIS。值得一读。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rw As Long
    Dim sPass As String

    '~~> Password
    sPass = "BlahBLah"

    On Error GoTo Whoa

    '~~> For excel 2003 use .Count instead of .CountLarge
    '~~> In case of multiple cells were changed        
    If Target.Cells.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False

    If Not Intersect(Target, Range("N5:N36")) Is Nothing Then
        If UCase(Trim(Target.Value)) = "EXIST" Then
            rw = Target.Row

            With ActiveSheet
                .Unprotect sPass

                .Cells.Locked = False

                .Range("O" & rw & ":U" & rw).Locked = True

                .Protect Password:= sPass , DrawingObjects:=True, _
                Contents:=True, Scenarios:=True
            End With
        End If
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Answer 2

你可以这样做：

Sub LockCells()

    'unprotect the sheet
    ActiveSheet.Unprotect

    'unlock all cells
    Cells.Locked = False
    Cells.FormulaHidden = False

    Dim cell As Range

    'find all cells that need to be locked
    For Each cell In Range("N5:N36")
        If cell = "Exist" Then

            Range("O" & cell.Row & ":U" & cell.Row).Locked = True
            Range("O" & cell.Row & ":U" & cell.Row).FormulaHidden = True

        End If
    Next cell

    'protect the sheet
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

需要帮助使用VBA锁定选定的单元格区域

2 个答案: