使用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是在那裏的某個地方。

注：這是我的頭和未經考驗的頂部，但應該工作，或至少讓你關閉