使用InStr函数来删除范围内的相似值

Question

下面的代码使用一个范围从工作表中删除行，我的worbook没有标准化，所以我的问题是如何在这里使用InStr函数也删除类似的值，即如果“苹果有限公司”在范围内，那么它会删除包含“苹果”的行或反之亦然......是否有可能？

更新：第28行：需要object @freeman我无法获得“Dim Cel as Range”的工作，我已经插入到这里并在工作表的顶部插入了相同的结果。你写的'Cel'的语法是？下面

Sub Loop_Example() 
    Dim ChkRange As Range 
     Dim Firstrow As Long 
     Dim Lastrow As Long 
     Dim Lrow As Long 
     Dim CalcMode As Long 
     Dim ViewMode As Long 
    Set ChkRange = Sheets("Sheet2").Range("A1:A13") 
     With Application 
      CalcMode = .Calculation 
      .Calculation = xlCalculationManual 
      .ScreenUpdating = False 
     End With 
     With Sheet1 
      .Select 
      ViewMode = ActiveWindow.View 
      ActiveWindow.View = xlNormalView 
      .DisplayPageBreaks = False 
      Firstrow = 2 
      Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 
      For Lrow = Lastrow To Firstrow Step -1 
       With .Cells(Lrow, "A") 
        If Not IsError(.Value) Then 
    If Not IsError(Application.Match(.Value, ChkRange, 0)) Then 
    .EntireRow.Delete 
    End If 
    For Each Cell In ChkRange 
     If InStr(1, Cell.Value, .Value) > 0 And Cell.Value <> .Value Then 
     'include the 2nd part of the "AND" to ensure you don't delete based 
     'on a COMPLETE match, only on a partial match as noted in the comments 
     Cell.EntireRow.Delete 
    End If 
    Next 
End If 

End With 
    Next Lrow 
     End With 
ActiveWindow.View = ViewMode 
With Application 
      .ScreenUpdating = True 
      .Calculation = CalcMode 
     End With 
    End Sub 

---

Sub Loop_Example() 
     Dim ChkRange As Range 
      Dim Firstrow As Long 
      Dim Lastrow As Long 
      Dim Lrow As Long 
      Dim CalcMode As Long 
      Dim ViewMode As Long 
     Set ChkRange = Sheets("Sheet2").Range("A1:A13") 
      With Application 
       CalcMode = .Calculation 
       .Calculation = xlCalculationManual 
       .ScreenUpdating = False 
      End With 
      With Sheet1 
       .Select 
       ViewMode = ActiveWindow.View 
       ActiveWindow.View = xlNormalView 
       .DisplayPageBreaks = False 
       Firstrow = 2 
       Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 
       For Lrow = Lastrow To Firstrow Step -1 
        With .Cells(Lrow, "A") 
         If Not IsError(.Value) Then 
     If Not IsError(Application.Match(.Value, ChkRange, 0)) Then 
     .EntireRow.Delete 
     End If 
     For Each Cell In ChkRange 
     Dim Cel As Range 
      If InStr(1, Cell.Value, .Value) > 0 And Cell.Value <> .Value Then 
      'include the 2nd part of the "AND" to ensure you don't delete based 
      'on a COMPLETE match, only on a partial match as noted in the comments 
      Cell.EntireRow.Delete 
     End If 
     Next 
    End If 

    End With 
     Next Lrow 
      End With 
    ActiveWindow.View = ViewMode 
    With Application 
       .ScreenUpdating = True 
       .Calculation = CalcMode 
      End With 
     End Sub 

Answer 1

如何使用InStr()原始删除一整行？修改代码

If Not IsError(.Value) Then 
    If Not IsError(Application.Match(.Value, ChkRange, 0)) Then 
    .EntireRow.Delete 
    End If 
End If 

的这部分内容是这样的：

Dim cel as range 'put this at the top of your code with your other Dim stmts 
If Not IsError(.Value) Then 
    If Not IsError(Application.Match(.Value, ChkRange, 0)) Then 
    .EntireRow.Delete 
    End If 
'note this changed row. Note carefully the SPELLING 
    for each Cel in ChkRange.Cells 
    if Instr(1, Cel.value, .Value) > 0 and ce.lValue <> .Value then 
     'include the 2nd part of the "AND" to ensure you don't delete based 
     'on a COMPLETE match, only on a partial match as noted in the comments 
     cel.EntireRow.Delete 
    end if 
    next 
End If 

这可能会比较慢，因为你必须通过每个细胞循环中ChkRange看看是否Sheet1.Cells(Lrow,"I").Value是在那里的某个地方。

注：这是我的头和未经考验的顶部，但应该工作，或至少让你关闭