单元格数据控制答案

【问题标题】：Data control for cell单元格数据控制
【发布时间】：2013-11-11 03:13:35
【问题描述】：

这就是我想做的。我有五列（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

【问题讨论】：

你可以使用radio/option buttons吗？ :)
不需要表单/ActiveX 控件。最简单的方法是使用Worksheet_Changeevent。
查看X 帖子末尾的示例HERE
有一个附加值，因为它涉及到点。我正在查看 Worksheet_Change 事件。我得到了这个
Private Sub Worksheet_Change(ByVal Target As Range) Me.Unprotect If Not IsEmpty(Target) Then '数据已添加到目标单元格中。锁定它的邻居。 Me.Cells(Target.Row, 1).Resize(, 4).Locked = True Target.Locked = False Else '数据已从目标单元格中删除。释放它的邻居。 Me.Cells(Target.Row, 1).Resize(, 4).Locked = False End If Me.Protect End Sub

标签： excel vba

【解决方案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

【讨论】：