细胞的数据控制

Question

这就是我想要做的。我有五列（A，B，C，D，E）。我的要求是，在每一行中，只有一个单元格应接受数据，其余单元格不应接受数据（即其余四个单元格应处于锁定模式）。

例如，如果用户在第1列中输入1，则BCDE将被锁定，但如果用户决定更改选项，则他们可以放回原始数据并更改为列中的其他值。以下是我想要做的一个示例。

VeryStrong   Strong   Neutral   Weak   VeryWeak
1              0        0        0        0      Data keyed by user 1
0              1        0        0        0      Data keyed by user 2
0              1        1        0        0      *This is what I am trying to prevent*

用户1可以返回并更改

Private Sub Worksheet_Change(ByVal Target As Range)
    Me.Unprotect
    If Not IsEmpty(Target) Then
        'Data was added in target cell. Lock its neighbours.
        Me.Cells(Target.Row, 1).Resize(, 5).Locked = True
        Target.Locked = False
    Else
        'Data was erased from target cell. Release its neighbours.
        Me.Cells(Target.Row, 1).Resize(, 5).Locked = False
    End If
    Me.Protect
End Sub

Answer 1

  

我试图找出代码并更改与特定列相关的代码，例如K9，L9，M9，N9，O9。 - Timothy Teoh 27分钟前

试试这个。 （已审判并已经过测试）

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyPass As String
    Dim Rw As Long

    MyPass = "Sid" '<~~ Change this to your password

    On Error GoTo Whoa

    If Target.Cells.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False

    If Not Intersect(Target, Range("K:O")) Is Nothing Then
        Rw = Target.Row

        ActiveSheet.Unprotect MyPass

        Select Case Target.Value
        Case Is > 0
            Range("K" & Rw & ":O" & Rw).Locked = True
            Target.Locked = False
        Case 0
            Range("K" & Rw & ":O" & Rw).Locked = False
        End Select
    End If

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