select基于find2列中的2个不同的单词

我想用Excel VBA做下面的事情：

1）在列中查找某个单词_1;

2）如果在步骤（1）中findword_1，则向右移动一列，然后查找称为word_2的另一个单词。 如果find了word_2，则删除整行。

另一方面，如果没有findword_2，则该行不必被删除。

总体思路是在一列中search多个单词，如果find了，则还要仔细检查（为了安全起见）某些附属单词是否在列2中。只有这样才能删除整行。

我做了以下testing的小例子：

Col1 Col2 xxx xxx xxx xxx xxx xxx findme acg xxx xxx findme xxx 

在这个例子中，我在第1列中search单词“findme”，在第2列中search相关单词“acg”。正如你所看到的，第4行必须被删除，因为这两个单词出现在一行中，而不是例如第6行，如果不是这种情况。

我的最终代码：

  Sub xxx() Dim aCell As Range, bCell As Range, aSave As String Dim fndOne As String, fndTwo As String fndOne = "findme" fndTwo = "acg" Dim ws As Worksheet: Set ws = ActiveWorkbook.ActiveSheet Application.DisplayAlerts = False Application.ScreenUpdating = False With ws Set aCell = .Columns(1).Find(What:=fndOne, LookIn:=xlValues, _ lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then aSave = aCell.Address Do If LCase(.Cells(aCell.row, 2).Value) Like Chr(42) & fndTwo & Chr(42) Then If bCell Is Nothing Then Set bCell = .Range("A" & aCell.row) Else Set bCell = Union(bCell, .Range("A" & aCell.row)) End If End If Set aCell = .Columns(1).FindNext(After:=aCell) Loop Until aCell.Address = aSave End If Set aCell = Nothing If Not bCell Is Nothing Then bCell.EntireRow.Delete End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

Answer 1

如果你使用了Range.Find方法和Range.FindNext方法 ，在你删除的时候删除，并且在每次删除之后检查匹配的logging，你应该能够快速地循环。

 'delete rows as they are found Sub delTwofers() Dim rw As Long, n As Long, cnt As Long, rng As Range Dim v As Long, sALLTERMs As String, vPAIRs As Variant, vTERMs As Variant On Error GoTo bm_SafeExit Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Debug.Print Timer sALLTERMs = "aa;bb|cc;dd|ee;ff" With Worksheets("Sheet1") 'set this worksheet reference properly! vPAIRs = Split(LCase(sALLTERMs), Chr(124)) For v = LBound(vPAIRs) To UBound(vPAIRs) vTERMs = Split(vPAIRs(v), Chr(59)) cnt = Application.CountIfs(.Columns(1), Chr(42) & vTERMs(0) & Chr(42), .Columns(2), Chr(42) & vTERMs(1) & Chr(42)) rw = 1 For n = 1 To cnt rw = .Columns(1).Find(what:=vTERMs(0), lookat:=xlPart, _ after:=.Columns(1).Cells(rw + (rw <> 1)), MatchCase:=False).Row Do While True If LCase(.Cells(rw, 2).Value2) Like Chr(42) & vTERMs(1) & Chr(42) Then .Rows(rw).Delete Exit Do Else rw = .Columns(1).FindNext(after:=.Cells(rw, 1)).Row End If Loop Next n Next v End With Debug.Print Timer bm_SafeExit: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.EnableEvents = True End Sub 'collect rows with Union, delete them all at once Sub delTwofers2() Dim rw As Long, n As Long, cnt As Long, rng As Range Dim v As Long, sALLTERMs As String, vPAIRs As Variant, vTERMs As Variant On Error GoTo bm_SafeExit Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Debug.Print Timer sALLTERMs = "aa;bb|cc;dd|ee;ff" With Worksheets("Sheet1") 'set this worksheet reference properly! vPAIRs = Split(LCase(sALLTERMs), Chr(124)) For v = LBound(vPAIRs) To UBound(vPAIRs) vTERMs = Split(vPAIRs(v), Chr(59)) cnt = Application.CountIfs(.Columns(1), Chr(42) & vTERMs(0) & Chr(42), .Columns(2), Chr(42) & vTERMs(1) & Chr(42)) rw = 1 For n = 1 To cnt rw = .Columns(1).Find(what:=vTERMs(0), lookat:=xlPart, _ after:=.Columns(1).Cells(rw), MatchCase:=False).Row Do While True If LCase(.Cells(rw, 2).Value2) Like Chr(42) & vTERMs(1) & Chr(42) Then If rng Is Nothing Then Set rng = .Cells(rw, 1) Else Set rng = Union(rng, .Cells(rw, 1)) End If Exit Do Else rw = .Columns(1).FindNext(after:=.Cells(rw, 1)).Row End If Loop Next n Next v End With Debug.Print Timer 'check timer before deleting discontiguous rows If Not rng Is Nothing Then _ rng.EntireRow.Delete Debug.Print Timer bm_SafeExit: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.EnableEvents = True End Sub 

通过首先检查确定有东西要删除，可以避免一些错误控制; 您只需要find您知道存在的双重匹配条件的条目。

附录：删除不连续行的集合是非常耗时的。 上面的第二个例程（ delTwofers2 ）比find的行删除行慢了5％。 25,000个值，755个随机删除 – 第一个为3.60秒; 后者为3.75秒。

Answer 2

此代码使用您的条件将filter应用于使用范围的前两列。 然后它删除可见的行：

 Sub DeleteSelected() Dim RangeToFilter As Excel.Range Set RangeToFilter = ActiveSheet.UsedRange With RangeToFilter .AutoFilter Field:=1, Criteria1:="find me" .AutoFilter Field:=2, Criteria1:="access granted" .SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp End With End Sub