防止excel单元格有效性验证因被粘贴而失效

将代码放在sheet1后,当单元格内容有变化时,会触发change事件,达到验证目的


Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rng As Range
   Dim c As String
    For Each rng In Target
    If Not rng.Validation.Value Then
        Application.Undo
        Dim msg As String
        msg = "粘贴的数据不符合校验规则:位置在第" & rng.Row & "行,第" & getColumnName(rng.column) & "列,请仔细检查"
        MsgBox prompt:=msg, Title:="输入提示"
    Exit For
    End If
Next
End Sub


Private Function getColumnName(column As Integer) As String
    Dim alphabet(26) As String
    alphabet(0) = "A"
    alphabet(1) = "B"
    alphabet(2) = "C"
    alphabet(3) = "D"
    alphabet(4) = "E"
    alphabet(5) = "F"
    alphabet(6) = "G"
    alphabet(7) = "H"
    alphabet(8) = "I"
    alphabet(9) = "J"
    alphabet(10) = "K"
    alphabet(11) = "L"
    alphabet(12) = "M"
    alphabet(13) = "N"
    alphabet(14) = "O"
    alphabet(15) = "P"
    alphabet(16) = "Q"
    alphabet(17) = "R"
    alphabet(18) = "S"
    alphabet(19) = "T"
    alphabet(20) = "U"
    alphabet(21) = "V"
    alphabet(22) = "W"
    alphabet(23) = "X"
    alphabet(24) = "Y"
    alphabet(25) = "Z"

    
    If (column < 27) Then
        getColumnName = alphabet(column - 1)
    Else
        Dim i, j As Integer
        i = column \ 26
        j = column Mod 26
        If (i < 26) Then
            getColumnName = alphabet(i - 1) & alphabet(j - 1)
        Else
            getColumnName = column
        End If
            
    End If
    
End Function



  • 2
    点赞
  • 13
    收藏
    觉得还不错? 一键收藏
  • 4
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 4
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值