Excel VBA粘贴时保留单元格数据验证 新增10位字母数字校验

现有VBA代码可实现指定区域双击触发剪贴板内容粘贴功能，但直接给单元格Value属性赋值的写法会绕过Excel原生的数据验证规则，需要解决两个问题：

• 执行粘贴操作时保留单元格原有的数据验证规则
• 增加自定义校验逻辑，限制粘贴内容仅为字母数字格式文本，且字符数不超过10

原有问题代码 #

全局模块代码：

Public Clipboard As New MSForms.DataObject
Sub Paste()
'Tools -> References -> Microsoft Forms 2.0 Object Library
'or you will get a "Compile error: user-defined type not defined"
Dim DataObj As New MSForms.DataObject
Dim S As String
DataObj.GetFromClipboard
S = DataObj.GetText
'Debug.Print S 'print code in the Intermediate box in the Macro editor
Target.Value = S
End Sub

工作表事件代码：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Application.Intersect(Target, Range("k4:s8")) Is Nothing Then
 Cancel = True
 Call Paste
 End If
End Sub

注：原有代码存在参数传递问题，Paste过程中直接使用Target变量未做定义，会触发运行时错误。

直接给单元格赋值的操作默认不会触发原生数据验证，因此需要在赋值后手动触发验证检查；自定义格式校验使用正则表达式实现，在赋值前拦截不符合要求的内容。

修改后完整代码 #

1. 全局模块Paste过程 #

Sub Paste(Target As Range)
    ' 依赖：Microsoft Forms 2.0 Object Library（已在原有代码中引用）
    ' 正则使用晚绑定，无需额外添加引用
    Dim DataObj As New MSForms.DataObject
    Dim pasteText As String
    Dim reg As Object
    
    ' 读取剪贴板文本，读取失败直接退出
    On Error Resume Next
    DataObj.GetFromClipboard
    pasteText = DataObj.GetText
    On Error GoTo 0
    If Len(pasteText) = 0 Then Exit Sub
    
    ' 自定义校验：仅允许大小写字母+数字，长度1-10位
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "^[a-zA-Z0-9]{1,10}$"
    If Not reg.Test(pasteText) Then
        MsgBox "粘贴无效：仅支持输入字母、数字，长度不可超过10个字符", vbExclamation
        Exit Sub
    End If
    
    ' 写入内容
    Target.Value = pasteText
    
    ' 触发单元格原有数据验证规则
    If Not Target.Validation Is Nothing Then
        ' 跳过仅做输入提示的验证规则
        If Target.Validation.Type <> xlValidateInputOnly Then
            Target.Validation.Validate
            ' 验证不通过则撤销写入，弹出规则对应提示
            If Target.Validation.Value = False Then
                Application.Undo
                Dim tipText As String
                tipText = Target.Validation.ErrorMessage
                If Len(tipText) = 0 Then tipText = "输入内容不符合该单元格的数据验证规则"
                MsgBox tipText, vbExclamation
            End If
        End If
    End If
End Sub

2. 工作表双击事件代码 #

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("k4:s8")) Is Nothing Then
        Cancel = True
        ' 传入目标单元格对象，修复原代码参数缺失问题
        Call Paste(Target)
    End If
End Sub

补充说明 #

• 原有代码中声明的全局变量Clipboard未被使用，可直接删除减少冗余。
• 原生数据验证通过调用Validation.Validate方法触发，完全复用单元格上已配置的所有规则，后续修改单元格验证规则时无需同步调整VBA代码。
• 如果不想使用正则校验，可替换为逐字符遍历检查的逻辑，正则写法的执行效率和简洁度更优。

内容的提问来源于stack exchange，提问作者2Took