vba 删除不包含在范围中定义的设置值的行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19019304/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
vba deleting rows that do not contain set values defined in range
提问by Rachel Netto Redden
I have a sheet of data with 25k lines. I need to search the entire sheet for certain words that I've defined in a named range on tab 2, called "KeywordSearh". The range contains a list of words I need to look up in the main data. I want to delete all rows that DO NOT contain these key words (and move all retaining rows up) and retain only the rows with reference to the keywords (including the titles row). Keywords could be written as text inside any cell which will also contain other text, so the search function needs to look within each string and not be case specific.
我有一张 25k 行的数据表。我需要在整个工作表中搜索我在选项卡 2 的命名范围中定义的某些单词，称为“KeywordSearh”。该范围包含我需要在主数据中查找的单词列表。我想删除所有不包含这些关键字的行（并将所有保留行向上移动）并仅保留参考关键字的行（包括标题行）。关键字可以写为任何单元格内的文本，该单元格也将包含其他文本，因此搜索功能需要在每个字符串中查找，而不是特定于大小写。
I think the code on link below is close, but this is does not refer to a range. Also, I only need to search one worksheet called "FAIR". VBA Looping Over Sheets: Delete rows if cell doesn't contain
我认为下面链接上的代码很接近，但这不是指范围。另外，我只需要搜索一张名为“FAIR”的工作表。 VBA 循环工作表：如果单元格不包含则删除行
I'm a complete novice to VBA so any assistance is extremely appreciated.
我是 VBA 的完全新手，因此非常感谢任何帮助。
回答by
Here is a non VBA way to do it. Select the range you want to alter, go to conditional formatting > highlight cell rules > more rules > use formula to determine which cells to format. Select a color to highlight the cells and type this formula with your ranges:
这是一种非 VBA 方法。选择要更改的范围，转到条件格式>突出显示单元格规则>更多规则>使用公式来确定要设置格式的单元格。选择一种颜色以突出显示单元格，然后使用您的范围键入此公式：
=COUNTIF(FAIR!$A$1:$A$10,A1)where FAIR!$A$1:$A$10 is your keyword range and A1 is the first cell of the range you are trying to alter.
=COUNTIF(FAIR!$A$1:$A$10,A1)其中 FAIR!$A$1:$A$10 是您的关键字范围，A1 是您要更改的范围的第一个单元格。
You can then filter your list by color = no fill, select and delete only visible cells (Ctrl+G > Special > Visible Cells Only).
然后，您可以按颜色过滤列表 = 无填充，仅选择和删除可见单元格（Ctrl+G > 特殊 > 仅可见单元格）。
回答by Jose M.
The procedure below searches your entire worksheet for an array of values and then deletes all rows in the worksheet where those values are not found.
以下过程在整个工作表中搜索一组值，然后删除工作表中未找到这些值的所有行。
This code is adapted from another site, for some reason I could not paste the link here.
此代码改编自另一个站点，出于某种原因，我无法将链接粘贴到此处。
First you need to create a function to find the last row:
首先，您需要创建一个函数来查找最后一行：
Public Function GetLastRow(ByVal rngToCheck As Range) As Long
Dim rngLast As Range
Set rngLast = rngToCheck.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastRow = rngToCheck.Row
Else
GetLastRow = rngLast.Row
End If
End Function
Now, use the code below to find the values on an array. It will search the entire worksheet and delete any row where that value is not found.
现在，使用下面的代码查找数组中的值。它将搜索整个工作表并删除未找到该值的任何行。
Sub Example1()
Dim varList As Variant
Dim lngarrCounter As Long
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Application.ScreenUpdating = False
varList = VBA.Array("Here", "There", "Everywhere") 'You will need to change this to reflect your Named range
For lngarrCounter = LBound(varList) To UBound(varList)
With Sheets("Fair").UsedRange 'Change the name to the sheet you want to filter
Set rngFound = .Find( _
What:=varList(lngarrCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
End If
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngarrCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Let me know if you need further assistance.
如果您需要进一步的帮助，请告诉我。
