问从不同来源复制/粘贴数据时，Excel中的数据验证如何工作

EN

Sub NotAllowPaste()
Dim UndoList As String
If ThisWorkbook.Name <> ActiveWorkbook.Name Then Exit Sub
With Application
  .EnableEvents = False
  UndoList = .CommandBars("Standard").Controls("&Undo").List(1)
  If InStr(UndoList, "Paste") > 0 Or _
    UndoList = "Keep Source Formatting" Or _
    UndoList = "Drag and Drop" Then
        .Undo
        MsgBox "Pasting and ""drag and drop"" is forbidden in this workbook.", vbCritical
  End If
  .EnableEvents = True  
End With
End Sub

Private Sub Worksheet_Activate()
  Application.DisplayFormulaBar = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  NotAllowPaste
End Sub

Private Sub Worksheet_Deactivate()
  Application.DisplayFormulaBar = True
End Sub

Sub ListToCheck(rng As Range)
Dim cl As Range
Dim i As Integer
Dim bMatch As Boolean
Dim sListName As String

sListName = "sheet2!MyList" 'change this accrording to your needs
bMatch = False

For Each cl In rng.Cells
    With WorksheetFunction
    For i = 1 To .CountA(Range("MyList"))
        If cl.Value = .Index(Range(sListName), i) Then bMatch = True
    Next i
    End With

    With cl.Interior
    If bMatch Then
        .ColorIndex = 0
    Else
        .Color = vbYellow
    End If
    End With
    bMatch = False
Next cl

End Sub

Sub ValueToCheck(rng As Range, minV As Long, maxV As Long)
Dim cl As Range
Dim bOk As Boolean

For Each cl In rng.Cells
    With cl
    If IsNumeric(.Value) Then

        If .Value < minV Or .Value > maxV Then
            .Interior.Color = vbYellow
         Else
            .Interior.ColorIndex = 0
        End If
    Else
        .Interior.Color = vbYellow
    End If
    End With
Next cl
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim col As Range
Dim colAdr As String

For Each col In Target.Columns
    colAdr = col.Address(ReferenceStyle:=xlR1C1)
    Select Case Right(colAdr, Len(colAdr) - InStrRev(colAdr, "C"))
        Case Is = 1
            ListToCheck col
        Case Is = 2
            ValueToCheck col, 1000000, 9999999
        End Select
Next col
End Sub