对数据有效性的保护

scl2003921

各位大神，我的表格中设置了二级下拉菜单，我想：
1、防止别人通过复制粘贴、下拉，破坏我设置的数据有效性（数据源表已隐藏，可通过在工作表名称取消隐藏，显示单独的sheet：“数据源”）；
2、如果B列的某个数据删除了，我想让同一行D列的数据自动清空。



下面是我的代码，存放在thisworkbookt，但无法实现上述2个功能。请帮忙看一下哪里出了问题。感谢！


Sub Worksheet_Activate()   '禁止复制、粘贴、下拉填充
    With Application
        .CellDragAndDrop = False
        .OnKey "^{v}", " "
        .CutCopyMode = False
    End With
End Sub

Sub Worksheet_SelectionChange() '禁止复制、粘贴
    Application.CutCopyMode = False
End Sub

Sub Worksheet_Deactivate() '恢复禁止复制、粘贴
    With Application
        .CellDragAndDrop = True
        .OnKey "^{v}"
    End With
End Sub

Sub Worksheet_Change(ByVal Target As Range) '当B列某单元格内容删除时，同一行D列单元格内容也应清空
    If Target.Column = 2 Then
        If Target.Value = "" Then
            Target.Offset(, 2) = ""
        End If
    End If
End Sub

3190496160

总表保护不是有保护数据有效性的功能的吗

scl2003921

3190496160 发表于 2023-6-2 08:53
总表保护不是有保护数据有效性的功能的吗

菜单项不能保护数据有效性，我百度的结果也是说Excel表还未提供此功能。
请老师百忙之中看一下我的代码有啥问题，谢谢！

scl2003921

将代码由thisworkbook，转移到需要保护数据有效性的“监盘表”中，稍微修改，代码可以运行了，基本能实现前面的功能了。
但有时会出现一点问题：
1、“监盘”表中复制、粘贴、下拉偶尔还是能用，但我也不知道什么情况下会发生；
2、当功能正常时，却出现提示：
请各位高手帮忙看一下这是什么问题？

scl2003921

经过修改，目的基本能实现：
1、禁止复制粘贴、下拉填充破坏数据有效性；不存在时好时坏的现象了。
2、C列某个数据删除了，同一行D、E两列数据自动删除；
3、不会出现复制粘贴时，错误提示了（见4楼）
但，还存在一个问题：
在上述第2条操作时，如果只清空C列一个单元格，正常运行；如果同时清空C列多个单元格，则出错，改了代码也出错（请见第2段）。
请哪位老师帮忙看一下问题出在哪里？
第一段：
Sub Worksheet_Change(ByVal Target As Range) '在“监盘”表中，当B列某单元格内容删除时，同一行C、D列单元格内容也应清空
    If Target.Column = 3 Then
        If Target.Value = "" Then
            Target.Offset(, 1).Resize(1, 2) = ""
        End If
    End If
End Sub

第二段
Sub Worksheet_Change(ByVal Target As Range) '若C列同时选择多行，修改代码仍不能正常运行。 在“监盘”表中，当B列某单元格内容删除时，同一行C、D列单元格内容也应清空

  If Target.Column = 3 Then
       If Target.Value = "" Then
           Target.Offset(, 1).Resize(Target.rows.count, 2) = ""
       End If
    End If
End Sub

scl2003921

与上一贴相同，重复发帖，删除此帖内容。

scl2003921

scl2003921 发表于 2023-6-8 20:20
经过修改，目的基本能实现：
1、禁止复制粘贴、下拉填充破坏数据有效性；不存在时好时坏的现象了。
2、C ...

已经解决该问题，感谢罗刚君老师的指导！
Sub Worksheet_Change(ByVal Target As Range)    '在“监盘”表中，当B列某单元格内容删除时，同一行C、D列单元格内容也应清空
    Application.EnableEvents = False
    If Target.Column = 3 Then
        If Target.Cells.Count = 1 Then
            If Target.Value = "" Then
                Target.Offset(, 1).Resize(1, 2) = ""
            End If
        Else
            Dim cell As Range, Rng As Range
            Set Rng = Application.Intersect(Target, Target.Parent.UsedRange)
            Rng.Offset(0, 1).Resize(Rng.Rows.Count, 2) = ""
        End If
    End If
    Application.EnableEvents = True
End Sub