根据选定的数据验证，在特定列中禁止粘贴功能，同时仍在同一数据验证列中启用粘贴

Disallowing Pasting capabilities in Specific columns based on selected Data Validation while still enabling pasting in the same Data validation column

提问人：Bastian 提问时间：10/27/2023 最后编辑：Bastian 更新时间：10/27/2023 访问量：37

问：

首先，让我先说我对任何形式的编码都很陌生，VBA 是我第一次尝试学习它，而且我学得并不快。

我的问题是我有一张表，我打算把它交给供应商，让他们填写我们的产品信息。我提供了下拉列表，并尝试创建一些公式来减少供应商必须做的工作，同时还控制我返回的数据是有意义的。不幸的是，供应商决定复制并粘贴到覆盖数据验证的下拉选项之上，使我最初付出的努力变得多余，同时删除了任何形式的数据标准化。

我想创建一些代码，使我能够限制复制和粘贴单元格的能力

  1. 不包含数据验证
  2. 是与分配给该列的数据验证不同类型的数据验证
  3. 维护将特定列中的单元格复制并粘贴到同一列中 例如，列 E：E 有 3 个可供选择的值（红色、蓝色、黄色）。G：G 列有 5 个可供选择的值（大众、沃尔沃、MINI、梅赛德斯、捷豹） 我希望 E：E 能够进入 E 列内部，但不能进入 G 列，即使两者都有数据验证。

我关注了很久以前发布的一个线程：

初始源线程

辅助源线程

在次要来源线程中，有一个讨论有助于描述我的确切挑战，但在答案的评论中没有引导任何地方

以下是我正在使用的代码

`Dim boolDontShowAgain As Boolean

 Private Sub Worksheet_Change(ByVal Target As Range)
     On Error GoTo Whoa

      Application.EnableEvents = False

 'Does the validation range still have validation?
 If Not HasValidation(Range("PIM - MASTER DATA!A3:A999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!G3:G999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!H3:H999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!I3:I999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!O3:O999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!P3:P999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!Q3:Q999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!R3:R999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!S3:S999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!R3:R999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!AF3:AF999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!AG3:AG999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!BG3:BG999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!BH3:BH999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!BR3:BR999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!BS3:BS999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!CG3:CG999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!CH3:CH999")) Then RestoreValidation
 If Not HasValidation(Range("PIM - MASTER DATA!CI3:CI999")) Then RestoreValidation

 Letscontinue:
     Application.EnableEvents = True
     Exit Sub
 Whoa:
     MsgBox Err.Description
     Resume Letscontinue
 End Sub

 Private Sub RestoreValidation()
     Application.Undo
     If boolDontShowAgain = False Then
         MsgBox "Your last operation was canceled." & _
         "It would have deleted data validation rules.", vbCritical
         boolDontShowAgain = True
     End If
 End Sub

 Private Function HasValidation(r) As Boolean
     On Error Resume Next
     Debug.Print r.Validation.Type
     If Err.Number = 0 Then HasValidation = True
 End Function`
Excel VBA 验证 复制粘贴 限制

评论

答：

0赞 vbakim 10/27/2023 #1

尝试以下代码，列的条件设置为 1 （A） 和 5 （E），并且不会触发第 1 行 （cell.第 > 1 行）。根据需要针对特定列和行进行调整。

Dim AllowUndo As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    On Error GoTo ErrorHandler
    
    Application.EnableEvents = False

    ' Check if undo operation is allowed
    If AllowUndo Then
        AllowUndo = False
        GoTo ExitProcedure
    End If
    
    For Each cell In Target
        If (cell.Column = 1 And Not HasValidation(cell) And cell.Row > 1) Or _
           (cell.Column = 5 And Not HasValidation(cell) And cell.Row > 1) Then
            GoTo RestoreValidation
        End If
    Next cell

ExitProcedure:
    Application.EnableEvents = True
    Exit Sub

RestoreValidation:
    MsgBox "Your last operation was canceled." & _
           "It would have deleted data validation rules.", vbCritical
    
    ' Enable undo operation
    AllowUndo = True
    Application.EnableEvents = True
    Application.Undo
    Exit Sub

ErrorHandler:
    MsgBox Err.Description
    Resume ExitProcedure
End Sub

Private Function HasValidation(r As Range) As Boolean
    On Error Resume Next
    If Err.Number = 0 Then HasValidation = Not IsEmpty(r.Validation.Type)
End Function

评论

0赞 Bastian 10/28/2023
好的，太好了，这适用于我试图实现的前半部分！这比我以前得到的更远。但是，现在我希望防止从一列下拉菜单复制到另一列下拉菜单。现在：如果单元格没有验证并粘贴到下拉单元格中，则会弹出错误。但是，如果我将具有下拉验证的单元格粘贴到具有下拉验证的另一列中，则新粘贴的下拉菜单将覆盖上一个下拉菜单。我们能否在保持列间粘贴的同时防止这种情况发生？

上一个：复制和粘贴用户定义的范围

下一个：如何创建 HTML 电子邮件以防止用户在复制粘贴时意外选择额外的空格