使用 Excel VBA 和范围删除一些数据

Question

我正在为我热切的新老板设定的任务寻求一些指导！

我有一个命名范围“列表”中的错误代码列表，以及一个需要识别“代码”的特定错误代码列表。

我需要的是一些 VBA 代码，它将检查“列表”，如果存在任何不在“代码”列表中的代码，它将删除它。 （因此，如果它在“代码”范围内，它会保留，否则它会被删除）。

有人可以帮我吗？

到目前为止，我已经得到了这个代码，但它只会做相反的事情并删除我想要保留的代码！

Sub DeleteCodes()
  Application.ScreenUpdating = False
  Dim InRange As Range, CritRange As Range
  Dim InCell As Range, CritCell As Range

  Set InRange = Range("Data")           ' all selected source cells
  Set CritRange = Range("List")         ' the named range of words to be excluded

  For Each InCell In InRange.Cells
    For Each CritCell In CritRange.Cells
      If InCell = CritCell Then
        InCell = ""                     ' blank it
        Exit For                        ' exit inner for
      End If

    Next CritCell
  Next InCell

  Application.ScreenUpdating = True
End Sub

Answer 1

   Sub DeleteCodes()

        Dim InRange As Range, InCell As Range
        Dim CritRange As Range
        Dim v, f As Range

        Set InRange = Range("Data")   ' all selected source cells
        Set CritRange = Range("List") ' the named range of words to be excluded

        Application.ScreenUpdating = False
        For Each InCell In InRange.Cells
            Set f = CritRange.Find(InCell.Value, , xlValues, xlWhole)
            If f Is Nothing Then InCell.Value = ""
        Next InCell
        Application.ScreenUpdating = True
    End Sub

Answer 2

尝试：

Sub DeleteCodes()
  Dim rCell As Range

  Application.ScreenUpdating = False

  For Each rCell In [List].Cells
      If Application.WorksheetFunction.CountIf([Codes], rCell.Value) = 0 Then
        rCell.Value = ""
  Next rCell

  Application.ScreenUpdating = True
End Sub