0

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

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

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

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

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
4

2 回答 2

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
于 2019-08-14T11:58:38.740 回答
0

以下怎么样，它将检查目标值是否为空并提示一条消息，您可能还需要查看您如何保护和取消保护工作表，因为我不确定用户如何输入数据，如果它受到保护。

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
于 2019-08-14T11:45:44.707 回答