Excel 2016 VBA 运行时错误 13

Question

我编写了下面的代码，仅当 B 列相应行中的单元格值更改为特定列表/范围 (B118:B124) 的一部分时，才清除 D 列中的单元格。如果我将 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