跨工作表数据验证VBA方案咨询：粘贴数据失效问题

核心思路 #

借助Excel工作表的Worksheet_Change事件，监听Sheet1中G列的所有数据变更（包括粘贴操作），自动校验数据是否存在于Sheet2的目标区域，不符合条件的单元格立即标红并添加错误提示。

实现步骤 #

1. 按Alt+F11打开VBA编辑器，在左侧工程窗口找到Sheet1，双击打开其代码窗口。
2. 粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim checkRange As Range
    Dim cell As Range
    Dim matchResult As Variant
    
    ' 替换为Sheet2中实际的校验数据范围，例：Sheet2的A1:A1000或动态区域CurrentRegion
    Set checkRange = ThisWorkbook.Sheets("Sheet2").Range("A1").CurrentRegion
    
    ' 仅处理G列的单元格变更
    Set Target = Intersect(Target, Me.Columns("G"))
    If Target Is Nothing Then Exit Sub
    
    ' 关闭事件触发，避免循环执行
    Application.EnableEvents = False
    
    For Each cell In Target
        If cell.Value <> "" Then
            ' 查找当前值是否在校验范围中
            matchResult = Application.Match(cell.Value, checkRange, 0)
            
            If IsError(matchResult) Then
                ' 数据不存在：标红单元格并添加批注提示
                cell.Interior.Color = RGB(255, 0, 0)
                If Not cell.Comment Is Nothing Then cell.Comment.Delete
                cell.AddComment "该数据未在Sheet2校验表中存在"
                cell.Comment.Visible = False
            Else
                ' 数据存在：恢复默认格式并清除批注
                cell.Interior.Color = xlNone
                If Not cell.Comment Is Nothing Then cell.Comment.Delete
            End If
        Else
            ' 空单元格：恢复格式并清除批注
            cell.Interior.Color = xlNone
            If Not cell.Comment Is Nothing Then cell.Comment.Delete
        End If
    Next cell
    
    ' 重新开启事件触发
    Application.EnableEvents = True
End Sub

关键说明 #

• 校验范围调整：如果Sheet2的校验数据不是连续区域，直接修改checkRange的定义，比如Set checkRange = ThisWorkbook.Sheets("Sheet2").Range("B2:Z1000")；若数据是动态增减的，Range("A1").CurrentRegion会自动识别所有连续数据单元格。
• 事件防循环：Application.EnableEvents = False避免设置单元格格式时反复触发Worksheet_Change事件。
• 错误提示方式：采用批注而非数据验证，因为数据验证对粘贴操作无效，批注可在鼠标悬浮时显示提示，不影响数据编辑。

测试验证 #

直接将数据粘贴到Sheet1的G列，不在Sheet2校验范围内的单元格会自动变为红色，鼠标悬浮可查看错误提示；符合条件的单元格保持默认格式。

内容的提问来源于stack exchange，提问作者Natasha Newell