Excel 2016 VBA运行时错误13

Question

我编写了下面的代码，以仅当B列对应行中的单元格的值更改为特定列表/范围的一部分的值时，才清除D列中的单元格（B118：B124）。 如果我将B中的单元格更改为不属于该列表的任何值，则D中相应行中的单元格将无法清除（这就是我想要的）。

下面的代码可以正常工作，除非，例如，如果我想同时删除B列中的5个（相邻）单元格，则会出现运行时错误13。如果在删除的第一个中输入新值，情况也是如此。 /空白单元格，然后尝试将其自动填充到其余已删除/空白单元格中。 基本上，如果我想同时更改B中的多个单元格（自动填充等），则下面的代码似乎不起作用。 如果我一次只删除/更改一个单元格（在B中），则效果很好。 任何帮助将不胜感激。 谢谢。

Private Sub Worksheet_Change (ByVal Target As Range)  

If Not Intersect(Target, Range("B:B")) Is Nothing Then
    If Application.WorksheetFunction.CountIf(Range("B118:B124"), Target) Then
        Range("D" & Target.Row).ClearContents
    End If
End If

End Sub

Answer 1

我认为问题是COUNTIF期望的是单数，而不是包含值的范围。 尝试以下方法：

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each cell In Range(Target.Address)
        If Application.WorksheetFunction.CountIf(Range("B118:B124"), cell) Then
            Range("D" & cell.Row).ClearContents
        End If
    Next cell
End If

End Sub

编辑：更新答案与大家的贡献：

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each cell In Target
        If Not Intersect(cell, Range("B:B")) Is Nothing Then
            If Application.WorksheetFunction.CountIf(Range("B118:B124"), cell) Then
                Application.EnableEvents = False
                    Range("D" & cell.Row).ClearContents
                Application.EnableEvents = True
            End If
        End If
    Next cell
End If

End Sub

Answer 2

选择范围时，在这种情况下必须单独处理每个范围。 循环目标范围并完成。

Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cell In Target
        If Not Intersect(cell, Range("B:B")) Is Nothing Then
            If Application.WorksheetFunction.CountIf(Range("B118:B124"), cell) Then
                Range("D" & cell.Row).ClearContents
            End If
        End If
    Next
End Sub