Question

因此，为了提出这个问题，我是一个大规模的编程菜鸟，所以任何帮助都会受到赞赏。我有以下代码阻止用户复制和粘贴应用了数据验证的范围：

Private Sub Worksheet_Change(ByVal Target As Range)
'Does the validation range still have validation?
If HasValidation(Range("Section")) Then
    Exit Sub
Else
    MsgBox "Error: You cannot paste data into these cells." & _
    " Please use the drop-down to enter data instead.", vbCritical
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
End If
End Sub

Private Function HasValidation(r) As Boolean
    'Returns True if every cell in Range r uses Data Validation
    On Error Resume Next
    x = r.Validation.Type
    If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function

然而，当我尝试将它应用于多个列（不仅仅是命名范围＆＃34; Section＆＃34;）时，它会中断。我尝试创建一个联合并使用该联合作为范围，但这对任何一个都没有帮助。

Private Sub Validationranges()
Dim r1, r2, r3, r4, r5, r6, r7, r8, Validationranges As Range
 Set r1 = Sheets(ActiveSheet).Range("Amort")
 Set r2 = Sheets(ActiveSheet).Range("Capcity")
 Set r3 = Sheets(ActiveSheet).Range("ELV")
 Set r4 = Sheets(ActiveSheet).Range("Level")
 Set r5 = Sheets(ActiveSheet).Range("ProcGrp")
 Set r6 = Sheets(ActiveSheet).Range("Region")
 Set r7 = Sheets(ActiveSheet).Range("Section")
 Set r8 = Sheets(ActiveSheet).Range("Tooling")

 Set Validationranges = Union(r1, r2, r3, r4, r5, r6, r7, r8)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Call Validationranges
    'Does the validation range still have validation?
    If HasValidation(Range("Validationranges")) Then
        Exit Sub
    Else
        MsgBox "Error: You cannot paste data into these cells." & _
        " Please use the drop-down to enter data instead.", vbCritical
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
End Sub

Private Function HasValidation(r) As Boolean
    'Returns True if every cell in Range r uses Data Validation
    On Error Resume Next
    x = r.Validation.Type
    If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function

如果有人可以编辑代码或建议其他任何令人敬畏的想法，谢谢。

快速编辑：并非所有列都经过数据验证，因此交替列需要从此规则中排除。

Edit2：更新的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
'Does the validation range still have validation?
If Not Application.Intersect(Target, (Union(Range("Amort"), Range("Capacity"), Range("ELV"), Range("Level"), Range("ProcGrp"), Range("Region"), Range("Section"), Range("Tooling")))) Is Nothing Then
'if changes happen on the validation ranges then undo
    MsgBox "Error: You cannot paste data into these cells." & _
    " Please use the drop-down to enter data instead.", vbCritical
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
End If
End Sub

Answer 1

如下所示，这将检查您输入的值是否在数据验证列表中，如果是，则不执行任何操作，如果它不是撤消：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range, r7 As Range, r8 As Range, ValidationRanges As Range
Set r1 = ws.Range("Amort")
Set r2 = ws.Range("Capcity")
Set r3 = ws.Range("ELV")
Set r4 = ws.Range("Level")
Set r5 = ws.Range("ProcGrp")
Set r6 = ws.Range("Region")
Set r7 = ws.Range("Section")
Set r8 = ws.Range("Tooling")

Set ValidationRanges = Union(r1, r2, r3, r4, r5, r6, r7, r8)
If HasValidation(Target) Then 'check if cell has validation
ValidationList = Target.Validation.Formula1 'get list of values from data validation list
    If InStr(ValidationList, Target.Value) > 0 Then 'if value entered is in validation list
    'OK value
    Else 'if value entered is not in validation list then
        If Not Application.Intersect(Target, ValidationRanges) Is Nothing Then
        'if changes happen on the validation ranges then undo
            MsgBox "Error: You cannot paste data into these cells." & _
            " Please use the drop-down to enter data instead.", vbCritical
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
    End If
End If
End Sub

Private Function HasValidation(r) As Boolean
    'Returns True if every cell in Range r uses Data Validation
    On Error Resume Next
    x = r.Validation.Type
    If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function

防止粘贴多个范围（excel / VBA）上应用的数据验证

1 个答案: