0

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

1 回答 1

0

我正在尝试找出代码并更改与特定列相关的内容，例如 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

在此处输入图像描述

于 2013-10-31T08:50:35.400 回答