防止粘贴到数据验证单元格中

Question

现在我能够限制用户在数据验证单元格上键入。但是，当用户将来自另一个源的文本粘贴到该数据验证单元格时，它会绕过检查/错误消息。我在VBA没有任何经验，但我已经复制和粘贴了几个张贴在网上的解决方案，无济于事。

Answer 1

恢复数据验证

标准模块，例如Module1

Option Explicit
Public Const dvWORKSHEETNAME As String = "Sheet1"
Public Const dvCELLADDRESS As String = "A1"
Public dvCELLVALUE As Variant
Sub RestoreDataValidation( _
ByVal Target As Range)
Dim dvCell As Range: Set dvCell = Target.Worksheet.Range(dvCELLADDRESS)
If Intersect(dvCell, Target) Is Nothing Then Exit Sub

If Not ContainsDataValidation(dvCell) Then

Application.EnableEvents = False
On Error GoTo ClearError

' Replace the following block with your validation.
' Best use the macro recorder while creating it.
' For 'Formula1:="1,2,3"' use the appropriate list separator
' (e.g. I need semicolons 'Formula1:="1;2;3"').
With dvCell.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="1;2;3"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

dvCell.Value = dvCELLVALUE

End If

dvCELLVALUE = dvCell.Value
SafeExit:
Application.EnableEvents = True

Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub

Function ContainsDataValidation( _
ByVal rg As Range) _
As Boolean
On Error Resume Next
Dim dv As Long: dv = rg.SpecialCells(xlCellTypeSameValidation).Count
On Error GoTo 0
ContainsDataValidation = (dv > 0)
End Function

表模块，例如Sheet1

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
RestoreDataValidation Target
End Sub

ThisWorkbookModule

Option Explicit
Private Sub Workbook_Open()
dvCELLVALUE = Me.Worksheets(dvWORKSHEETNAME).Range(dvCELLADDRESS).Value
End Sub