Question

我使用数据验证，用户只能在列表中选择两个值。

当单元格发生更改时，我还在使用“相交”方法在下一个单元格中添加时间戳。

但是，用户仍然可以删除值并将单元格留空，这是我需要防止的事情。

是否可以在下面的代码中实现？

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Pass As String
Pass = "somepassword"

ActiveSheet.Unprotect Password:=Pass

 If Not Intersect(Target, Me.ListObjects("Table1").ListColumns(6).DataBodyRange) Is Nothing Then

   On Error GoTo ErrHandler

   ActiveSheet.Unprotect Password:=Pass
   Target.Offset(0, 1).Value = Format(Now, "dd.mm.yyyy hh:mm")
   ActiveSheet.Protect Password:=Pass, DrawingObjects:=True, Contents:=True, 
   Scenarios:=True, AllowFiltering:=True


End If

ErrHandler:
Exit Sub

End Sub

Answer 1

尝试此代码：

Option Explicit

Dim OldTargetAddress As String
Dim OldTargetValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = OldTargetAddress And Target.Value = Empty Then
    Application.EnableEvents = False
    Target.Value = OldTargetValue
    Application.EnableEvents = True
    Exit Sub
End If


Dim Pass As String
Pass = "somepassword"

ActiveSheet.Unprotect Password:=Pass

 If Not Intersect(Target, Me.ListObjects("Table1").ListColumns(6).DataBodyRange) Is Nothing Then

   On Error GoTo ErrHandler

   ActiveSheet.Unprotect Password:=Pass
   Target.Offset(0, 1).Value = Format(Now, "dd.mm.yyyy hh:mm")
   ActiveSheet.Protect Password:=Pass, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True


End If

ErrHandler:
Exit Sub

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    OldTargetAddress = Target.Address
    OldTargetValue = Target.Value
End Sub

Answer 2

接下来，它将检查目标值是否为空并提示一条消息，您可能还需要查看如何保护和取消保护工作表，因为我不确定用户在保护数据后如何输入数据

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Pass As String
Pass = "somepassword"

If Not Intersect(Target, Me.ListObjects("Table1").ListColumns(6).DataBodyRange) Is Nothing Then
 ActiveSheet.Unprotect Password:=Pass
    On Error GoTo ErrHandler
    For Each acell In Target.Cells
        With acell
            If acell.Column = Me.ListObjects("Table1").ListColumns(6).Range.Column Then acell.Offset(0, 1).Value = Format(Now, "dd.mm.yyyy hh:mm")
        End With
    Next

    Set foundblank = Me.ListObjects("Table1").ListColumns(6).DataBodyRange.Find(What:="", LookIn:=xlValues, LookAt:=xlWhole)
    If Not foundblank Is Nothing Then
        MsgBox "Blank cell found", vbInformation, "Blank Found!"
        ActiveSheet.Protect Password:=Pass, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
        Exit Sub
    End If
    ActiveSheet.Protect Password:=Pass, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End If

ErrHandler:
Exit Sub
End Sub

不允许使用相交方法清空单元格

2 个答案: