vba - 防止粘贴在多个范围内应用的数据验证(excel/VBA)

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

但是，当我尝试将其应用于多个列(不仅仅是命名范围“Section”)时，它会中断。我尝试创建一个联合并将该联合用作范围，但这也无济于事。

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