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

Question

我正在寻找一些指导，我已经从我渴望的新老板设置了一个任务！

我已经列出了命名范围“List”中的错误代码，以及需要标识“Codes”的特定错误代码列表。

我需要的是一些将检查“列表”的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