多单元格粘贴触发Worksheet_Change类型不匹配错误排查

嘿，这个问题我之前也踩过坑！根源在于你直接用Target.Value和空字符串比较，但当Target是多个单元格（比如多单元格粘贴、批量清空）时，Target.Value返回的是一个数组，而不是单个字符串，数组和字符串""直接比较就会触发类型不匹配错误。

问题分析 #

你的错误行If Target.Column = 2 And Target.Row > 1 And Target.Value = "" Then有两个核心隐患：

1. 当Target包含多列/多行时，Target.Column和Target.Row只会返回区域左上角单元格的行列号，无法准确判断所有受影响的单元格。
2. 多单元格场景下Target.Value是数组类型，和字符串""直接比较必然触发类型不匹配。

修复后的完整代码 #

下面是修正后的代码，兼顾单/多单元格操作，同时加入了错误保护，避免事件失效：

Public Sub Worksheet_Change(ByVal Target As Range)
    Dim ans As Integer
    Dim affectedCell As Range
    Dim targetColRange As Range
    Dim deletedRow As Long
    Dim projectName As String
    
    ' 只锁定第2列（B列）、第2行及以下的单元格，排除表头和无关列
    Set targetColRange = Intersect(Target, Me.Columns(2), Me.Rows("2:" & Me.Rows.Count))
    If targetColRange Is Nothing Then Exit Sub ' 没有符合条件的单元格，直接退出
    
    ' 错误保护：确保即使出错也能恢复事件触发
    On Error GoTo Cleanup
    Application.EnableEvents = False ' 禁用事件，防止循环触发（比如删除行时再次触发Change）
    
    ' 遍历每个受影响的单元格，逐个处理
    For Each affectedCell In targetColRange
        ' 检查单元格是否被清空（兼容真空、公式空、空格）
        If Trim(affectedCell.Value & "") = "" Then
            ans = MsgBox("Are you sure you want to Delete this record? This cannot Be Undone !!!", vbYesNo + vbExclamation)
            If ans = vbYes Then
                deletedRow = affectedCell.Row ' 先保存行号，避免后续操作改变引用
                Application.Undo ' 恢复单元格原来的值，才能获取项目名称
                
                ' 获取被删除的项目名称
                projectName = Me.Cells(deletedRow, 2).Value
                
                ' 删除当前工作表的对应行
                Me.Rows(deletedRow).EntireRow.Delete
                
                ' --------------------------
                ' 在这里添加另一工作表删除对应记录的逻辑
                ' 示例（根据你的实际需求修改）：
                ' Dim wsOther As Worksheet
                ' Set wsOther = ThisWorkbook.Worksheets("你的目标工作表名称")
                ' Dim foundCell As Range
                ' Set foundCell = wsOther.Columns(1).Find(What:=projectName, LookIn:=xlValues, LookAt:=xlWhole)
                ' If Not foundCell Is Nothing Then
                '     foundCell.EntireRow.Delete
                ' End If
                ' --------------------------
            End If
        End If
    Next affectedCell

Cleanup:
    ' 无论是否出错，都要恢复事件触发
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "操作出错：" & Err.Description, vbCritical
        Err.Clear
    End If
End Sub

关键修复点说明 #

1. Intersect精准筛选：用Intersect(Target, Me.Columns(2), Me.Rows("2:" & Me.Rows.Count))直接锁定需要处理的区域，避免无关操作。
2. 遍历单个单元格：多单元格粘贴/清空时，逐个处理每个受影响的单元格，彻底解决数组和字符串的类型不匹配问题。
3. 错误处理块：On Error GoTo Cleanup确保即使代码出错，Application.EnableEvents也能恢复为True，否则后续的工作表事件会完全失效。
4. 提前保存行号：因为Undo和Delete会改变单元格的位置，先把要处理的行号存下来，避免后续引用出错。
5. 兼容多种空值情况：Trim(affectedCell.Value & "")可以处理单元格真空、公式返回空、或者仅含空格的情况，判断更准确。

额外建议 #

如果需要批量处理多个清空的单元格，不想逐个弹出确认框，可以修改逻辑：先收集所有要删除的行，再一次性弹出确认，这样操作更高效。

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