Question

所以我一直在使用以下代码：

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rCell As Range
Dim rChange As Range

On Error GoTo ErrHandler
Set rChange = Intersect(Target, Range("p10:p5000"))  'sets range that is targetted. i.e. the range the receipt is added
If Not rChange Is Nothing Then
    Application.EnableEvents = False
    For Each rCell In rChange
        If rCell > "" Then             'If statement - If cell in range is not blank, then..
            With rCell.Offset(0, 1)    'Input username when adjacent P is formatted
                .Value = UserName()
                rCell.Offset(0, 2).Value = Date & " " & Time() 'Input date/time when adjacent P is formatted

            End With

        Else
                                    'If deleting item in P column (receipt number) should result in removing the user stamp, remove first comma from the line below.
            rCell.Offset(0, 1).Clear

                    'If deleting item in P column (receipt number) should result in removing the timestamp, remove first comma from the line below.
            rCell.Offset(0, 2).Clear

        End If
    Next
End If
ExitHandler: 
   Set rCell = Nothing
   Set rChange = Nothing
   Application.EnableEvents = True
   Exit Sub
ErrHandler 
  MsgBox Err.Description
  Resume ExitHandler
End Sub

Public Function UserName()             'This function is required for the private sub worksheet change()
UserName = Environ$("UserName")    'i.e.Required for the username
End Function

总而言之，上面的意思是一旦将数据输入到P单元右边的两个单元，就产生一个用户标记和一个时间戳。

例如，当用户将数据输入到P19中时，在Q19中将有一个用户名标记，而在R19中将有一个时间戳记。

我希望有一个规则，一旦输入P中的数据，它将锁定相邻的Q和R单元。

问题：一旦P中存在输入，找到锁定Q和R的规则很容易，但是，我想更进一步，允许每次出现Q和R时都进行解锁和重新锁定仅覆盖P单元格。

例如，在输入P19中的数据后，一旦锁定Q19和R19，更改Q19和R19的唯一方法是： 1-取消保护工作表，进行更改，然后再次保护 2 将数据输入到P19中，它将以某种方式自动解锁Q19和R19以允许使用新印章，然后立即自动将其重新锁定。

我能想到的最接近的东西是

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Intersect(Range("Q1:R10000"), Target)
    If xRg Is Nothing Then Exit Sub
    Target.Worksheet.Unprotect Password:="Stuff"
    xRg.Locked = True
    Target.Worksheet.Protect Password:="Stuff"
End Sub

但是，我无法找到解锁/重新锁定解决方案。

这可行吗？

如果有人可以提出一个值得赞赏的解决方案，我一直在尝试提出一些无济于事的方法。

Excel VBA：仅当相邻单元格已输入数据时，才使用用户名标记锁定/重新锁定单元格

0 个答案: